lib/ban.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * Copyright (C) The #Seppo contributors. All rights reserved.
  12  *
  13  * This program is free software: you can redistribute it and/or modify
  14  * it under the terms of the GNU General Public License as published by
  15  * the Free Software Foundation, either version 3 of the License, or
  16  * (at your option) any later version.
  17  *
  18  * This program is distributed in the hope that it will be useful,
  19  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21  * GNU General Public License for more details.
  22  *
  23  * You should have received a copy of the GNU General Public License
  24  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25  *)
  26
  27 (** Brute force mitigation HTTP 429,
  28  * https://www.rfc-editor.org/rfc/rfc6585#section-4 *)
  29
  30 let fn  = "app/var/run/ipban.cdb"
  31 let cdb = Mapcdb.Cdb fn
  32
  33 (** Prepare a ready-to-use cdb.
  34 *)
  35 let prepare_cdb (db : Mapcdb.cdb) : Mapcdb.cdb =
  36   (* don't log in case banned *)
  37   let Cdb db' = db in
  38   let _ = db' |> File.restore_static in
  39   db
  40
  41 let chunk_s = 600.
  42
  43 (* if expiry sooner than 2 chunks in the future: None *)
  44 let check (db : Mapcdb.cdb) (tnow : Ptime.t) (k : string) : Ptime.t option =
  45   (* Logr.debug (fun m -> m "%s.%s %s" "Ban" "check" k); *)
  46   Option.bind
  47     (Mapcdb.find_string_opt k db)
  48     (fun t ->
  49        let noban v = Logr.debug (fun m -> m "%s.%s %s not banned (%s)" "Ban" "check" k v);
  50          None in
  51        (* Logr.debug (fun m -> m "%s.%s check %s" "Ban" "check" t); *)
  52        match t |> Ptime.of_rfc3339 with
  53        | Ok (t, _, _) ->
  54          let dt = 2. *. chunk_s |> Ptime.Span.of_float_s |> Option.get in
  55          let than = Ptime.sub_span t dt |> Option.get in
  56          if Ptime.is_earlier tnow ~than
  57          then (
  58            Logr.info (fun m -> m "%s.%s %s banned until %a" "Ban" "check" k Ptime.pp than);
  59            Some than)
  60          else noban "expired"
  61        | _ -> noban "time fail" (* is this too generous? *)
  62     )
  63
  64 (** Check for a ban for the request.
  65  *
  66  * db          ban db
  67  * tnow        time
  68  * req         http request
  69 *)
  70 let check_req (db : Mapcdb.cdb) (tnow : Ptime.t) (req : Cgi.Request.t) =
  71   match check db tnow req.remote_addr with
  72   | None   -> Ok req
  73   | Some t -> Http.s429_t t
  74
  75 (** add another chunk to the expiry in the ban db *)
  76 let escalate db tnow addr : unit =
  77   let base = match Mapcdb.find_string_opt addr db with
  78     | None -> tnow
  79     | Some v ->
  80       match v |> Ptime.of_rfc3339 with
  81       | Ok (t, _, _) -> max tnow t
  82       | Error _      -> tnow
  83   in
  84   let expiry = chunk_s
  85                |> Ptime.Span.of_float_s |> Option.get
  86                |> Ptime.add_span base |> Option.get
  87                |> Ptime.to_rfc3339 in
  88   Logr.info (fun m -> m "%s.%s addr: %s expiry: %s" "Ban" "escalate" addr expiry);
  89   let _ = Mapcdb.update_string addr expiry db in
  90   Logr.warn (fun m -> m "%s.%s TODO use a predicate to remove expired entries." "Ban" "escalate")
  91
  92 let escalate_req db tnow (r : Cgi.Request.t)=
  93   Ok (escalate db tnow r.remote_addr)
  94
  95 (*
  96  *
  97  * # Brute force protect authentication.
  98  *
  99  * ## Requirements
 100  *
 101  * 1) persistence on disc,
 102  * 2) fast lookup if a given address (ip4 or ip6 string) is blacklisted and not
 103  * expired,
 104  * 3) add penalty and refresh expiry,
 105  * 4) housekeeping (unaccessed expiry)
 106  *
 107  * ## Caveats
 108  *
 109  * 1) mitigate DOS (be savy with CPU, files, space)
 110  * 2) fast negative answer (not banned)
 111  * 3) slow penalty, do the housekeeping here
 112  * 4) slow ban lift/expiry, too
 113  *
 114  * ## Possible storage
 115  *
 116  * - separate files named after address, timestamp expiry (evtl. with offset),
 117  * content severity
 118  * or
 119  * - one binary file mmapped as a Bigarray
 120  * or
 121  * - one fixed-line-length text file mmapped as a Bigstring
 122  * or
 123  * - one Csexp file
 124  *)
 125