Merge pull request mtgred#8527 from NBKelly/ip-ban-functionality

ip ban framework

Author: NBKelly

src/clj/web/admin.clj

@@ -12,6 +12,11 @@
    [web.versions :refer [frontend-version banned-msg]]
    [web.ws :as ws]))
 
+(defn- last-ip-address
+  "Legacy because I got it wrong the first time"
+  [user]
+  (or (:last-ip-address user) (:lastIpAddress user)))
+
 (defmethod ws/-msg-handler :admin/announce
   admin--announce
   [{{user :user} :ring-req
@@ -116,6 +121,76 @@
         (ws/broadcast-to! [uid] :admin/user-edit {:error "Not found"})))
     (ws/broadcast-to! [uid] :admin/user-edit {:error "Not allowed"})))
 
+(def ip-ban-collection "ip-bans")
+
+(defmethod ws/-msg-handler :admin/look-up-ip
+  admin--look-up-ip
+  [{{db :system/db user :user} :ring-req
+    {:keys [username] :as data} :?data
+    uid :uid}]
+  (if (and (active-user? user)
+           (or (:ismoderator user) (:isadmin user)))
+    (if-let [res (mc/find-one-as-map db user-collection {:username username}
+                                         {:username 1
+                                          :lastIpAddress 1
+                                          :last-ip-address 1
+                                          :_id 0})]
+      (ws/broadcast-to! [uid] :admin/look-up-ip {:success (-> res
+                                                              (dissoc :lastIpAddress)
+                                                              (assoc :last-ip-address (last-ip-address res)))})
+      (ws/broadcast-to! [uid] :admin/look-up-ip {:error "Not found"}))
+    (ws/broadcast-to! [uid] :admin/look-up-ip {:error "Not allowed"})))
+
+(defmethod ws/-msg-handler :admin/fetch-ip-bans
+  admin--fetch-ip-bans
+  [{{db :system/db user :user} :ring-req
+    uid :uid}]
+  (if (and (active-user? user)
+           (or (:ismoderator user) (:isadmin user)))
+    (let [ip-bans (mc/find-maps db ip-ban-collection {}
+                                {:username 1
+                                 :ip-address 1
+                                 :_id 0})]
+      (ws/broadcast-to! [uid] :admin/fetch-ip-bans {:success ip-bans}))
+    (ws/broadcast-to! [uid] :admin/fetch-ip-bans {:error "Not allowed"})))
+
+(defmethod ws/-msg-handler :admin/ip-ban-user
+  admin--ip-ban-user
+  [{{db :system/db user :user} :ring-req
+    {:keys [username] :as data} :?data
+    uid :uid}]
+  (if (and (active-user? user)
+           (or (:ismoderator user) (:isadmin user)))
+    (if-let [res (mc/find-one-as-map db user-collection {:username username}
+                                         {:username 1
+                                          :lastIpAddress 1
+                                          :last-ip-address 1
+                                          :_id 0})]
+      (if-let [ip (last-ip-address res)]
+        (do
+          (prn "res: " res)
+          (prn "ip: " ip)
+          (mc/insert db ip-ban-collection {:username username :ip-address ip})
+          (ws/broadcast-to! [uid] :admin/ip-ban-user {:success {:username username
+                                                                :ip-address ip}}))
+        (ws/broadcast-to! [uid] :admin/ip-ban-user {:error "Legacy user? No IP Address on record"}))
+      (ws/broadcast-to! [uid] :admin/ip-ban-user {:error "Not found"}))
+    (ws/broadcast-to! [uid] :admin/ip-ban-user {:error "Not allowed"})))
+
+(defmethod ws/-msg-handler :admin/ip-unban-user
+  admin--ip-unban-user
+    [{{db :system/db user :user} :ring-req
+    {:keys [username] :as data} :?data
+      uid :uid}]
+  (if (and (active-user? user)
+           (or (:ismoderator user) (:isadmin user)))
+    (let [result (mc/remove db ip-ban-collection {:username username})
+          n (.getN result)]
+      (if (pos? n)
+        (ws/broadcast-to! [uid] :admin/ip-unban-user {:success username})
+        (ws/broadcast-to! [uid] :admin/ip-unban-user {:error "Not found"})))
+    (ws/broadcast-to! [uid] :admin/ip-unban-user {:error "Not allowed"})))
+
 (defmethod ws/-msg-handler :admin/fetch-users
   admin--fetch-users
   [{{db :system/db user :user} :ring-req

src/clj/web/auth.clj

@@ -107,17 +107,20 @@
   ;; note - if the user is behind a proxy, their IP will be the first on in x-forwarded-for
   ;; otherwise it will just be the remote-addr key for the request.
   ;; I'm hoping the nginx reverese proxy plays nice with this...
-  (let [client-ip (if-let [ips (get-in headers ["x-forwarded-for"])]
-                    (-> ips (str/split #",") first)
-                    remote-address)
+  (let [client-ip (or (some-> headers (get "x-forwarded-for") (str/split #",") first)
+                      (some-> headers (get "x-real-ip"))
+                      remote-address)
         user (mc/find-one-as-map db "users" {:username username})]
     (cond
-      (and user (:banned user)) (response 403 {:error (or @banned-msg "Account Locked")})
+      (and user (password/check password (:password user)) (:banned user))
+      (response 403 {:error (or @banned-msg "Account Locked")})
+      (and user (password/check password (:password user)) (mc/find-one-as-map db "ip-bans" {:ip-address client-ip}))
+      (response 403 {:error (or @banned-msg "Account Locked")})
       (and user (password/check password (:password user)))
       (do (mc/update db "users"
                      {:username username}
-                     {"$set" {:lastConnection (inst/now)
-                              :lastIpAddress (str client-ip)}})
+                     {"$set" {:last-connection (inst/now)
+                              :last-ip-address (str client-ip)}})
           (assoc (response 200 {:message "ok"})
                  :cookies {"session" (merge {:value (create-token auth user)}
                                             (:cookie auth))}))

src/cljs/nr/admin.cljs

@@ -178,7 +178,6 @@
                 :on-change #(update-pause-game-creation (.. % -target -checked))}]
        " Pause new game creation (allows draining games before maintenance)"]]]))
 
-
 (defn admin []
   (r/with-let [user (r/cursor app-state [:user])]
     [:div.page-container

src/cljs/nr/users.cljs

@@ -23,6 +23,33 @@
         {}
         success))))
 
+(defmethod ws/event-msg-handler :admin/fetch-ip-bans
+  [{{success :success} :?data}]
+  (when success
+    (swap! users-state assoc :ip-banned success)))
+
+(defmethod ws/event-msg-handler :admin/look-up-ip
+  [{{:keys [error success]} :?data}]
+  (if success
+    (let [{:keys [username last-ip-address]} success]
+      (prn "success: " success)
+      (swap! users-state assoc :ip-lookup-name username :ip-lookup-result last-ip-address))
+    (non-game-toast error nil)))
+
+(defmethod ws/event-msg-handler :admin/ip-ban-user
+  [{{:keys [error success]} :?data}]
+  (if success
+    (let [{:keys [username ip-address]} success]
+      (swap! users-state update :ip-banned conj {:username username :ip-address ip-address}))
+    (non-game-toast error nil)))
+
+(defmethod ws/event-msg-handler :admin/ip-unban-user
+  [{{:keys [error success]} :?data}]
+  (if success
+    (let [{:keys [username ip-address]} success]
+      (swap! users-state update :ip-banned #(filterv (fn [m] (not= username (:username m))) %)))
+    (non-game-toast error nil)))
+
 (defmethod ws/event-msg-handler :admin/user-edit
   [{{:keys [error success]} :?data}]
   (cond
@@ -70,6 +97,36 @@
            "Remove"]]
          [:span.title (:username d "")]]))]])
 
+(defn- ip-bans-list [users]
+  ;; here it's a list of {:username ... :address ...}
+  [:div.users-box.panel.blue-shade
+   [:ul.list
+    (doall
+      (for [d (sort-by #(str/lower-case (:username %)) @users)]
+        [:li.users-item
+         {:key (:username d)}
+         [:span
+          [:button.delete
+           {:on-click #(ws/ws-send! [:admin/ip-unban-user {:username (:username d)}])}
+           "Remove"]]
+         [:span.title (:username d "") " - " (:ip-address d)]]))]])
+
+(defn- ip-ban-user-add [state state-key]
+  [:form.msg-box {:on-submit #(let [username (state-key @state "")]
+                                (.preventDefault %)
+                                (when-not (str/blank? username)
+                                  (ws/ws-send! [:admin/ip-ban-user {:username username}])
+                                  (swap! state assoc state-key "")))}
+   [:input {:type "text"
+            :placeholder "Type username"
+            :value (state-key @state "")
+            :on-change #(swap! state assoc state-key (-> % .-target .-value))}]
+   (let [username (state-key @state "")
+         disabled (str/blank? username)]
+     [:button {:disabled disabled
+               :class (if disabled "disabled" "")}
+      "IP Ban User"])])
+
 (defn- user-add [state state-key add-fn]
   [:form.msg-box {:on-submit #(let [username (state-key @state "")]
                                 (.preventDefault %)
@@ -86,11 +143,35 @@
                :class (if disabled "disabled" "")}
       "Add"])])
 
+(defn- ip-lookup-box [state state-key]
+  (fn []
+    [:form.msg-box {:on-submit #(let [username (state-key @state "")]
+                                  (.preventDefault %)
+                                  (when-not (str/blank? username)
+                                    (ws/ws-send! [:admin/look-up-ip {:username username}])))}
+     [:input {:type "text"
+              :placeholder "Type username"
+              :value (state-key @state "")
+              :on-change #(swap! state assoc state-key (-> % .-target .-value))}]
+     [:input {:type "text"
+              :read-only true
+              :value (:ip-lookup-result @state "")
+              :placeholder "Look up an IP"}]
+    (let [username (state-key @state "")
+          disabled (str/blank? username)]
+      [:button {:disabled disabled
+                :class (if disabled "disabled" "")}
+       "Search"])]))
+
+
+
+
 (defn users-container []
   (r/with-let [mods (r/cursor users-state [:mods])
                specials (r/cursor users-state [:specials])
                tos (r/cursor users-state [:tos])
-               banned (r/cursor users-state [:banned])]
+               banned (r/cursor users-state [:banned])
+               ip-bans (r/cursor users-state [:ip-banned])]
     (let [s (r/atom {})
           rows [{:h3 "Moderators"
                  :cursor mods
@@ -109,19 +190,30 @@
                  :key :banned
                  :h4 "Ban user"}]]
       (fn []
-        (into [:div.container.panel.blue-shade.content-page]
-              (->> (for [row rows]
-                     [[:h3 (:h3 row)]
-                      (users-list (:cursor row) (remove-user (:key row)))
-                      [:h4 (:h4 row)]
-                      (user-add s (:key row) (add-user (:key row)))])
-                   (interpose [[:br]])
-                   (mapcat identity)
-                   (map-indexed (fn [idx itm] ^{:key idx} itm))))))))
+        [:div.container.panel.blue-shade.content-page
+         (into [:div]
+               (->> (for [{:keys [h3 cursor key h4] :as row} rows]
+                      ;; (if (= key :ip-bans)
+                      ;;   [[:h3 (:h3 row)]
+                      [[:h3 h3]
+                       (users-list cursor (remove-user key))
+                       [:h4 h4]
+                       (user-add s key (add-user key))])
+                    (interpose [[:br]])
+                    (mapcat identity)
+                    (map-indexed (fn [idx itm] ^{:key idx} itm))))
+         [:br]
+         [:h3 "IP Lookup"]
+         [ip-lookup-box users-state :ip-lookup-name]
+         [:br]
+         [:h3 "Ip Bans"]
+         [ip-bans-list ip-bans]
+         [ip-ban-user-add users-state :ip-ban-name]]))))
 
 (defn users []
   (r/with-let [user (r/cursor app-state [:user])]
     (ws/ws-send! [:admin/fetch-users])
+    (ws/ws-send! [:admin/fetch-ip-bans])
     [:div.page-container
      [:div.account-bg]
      (when (or (:isadmin @user) (:ismoderator @user))