Redirect plain-text rules (#39)

regex still untested
This commit is contained in:
Daniel J. Summers 2023-07-30 22:26:30 -04:00
parent dc6b066e79
commit 693a1df34f
2 changed files with 52 additions and 1 deletions

View File

@ -65,9 +65,21 @@ open System.Collections.Concurrent
/// settings update page</remarks>
module WebLogCache =
open System.Text.RegularExpressions
/// A redirect rule that caches compiled regular expression rules
type CachedRedirectRule =
/// A straight text match rule
| Text of string * string
/// A regular expression match rule
| RegEx of Regex * string
/// The cache of web log details
let mutable private _cache : WebLog list = []
/// Redirect rules with compiled regular expressions
let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list> ()
/// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) =
_cache
@ -78,6 +90,16 @@ module WebLogCache =
/// Cache the web log for a particular host
let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
_redirectCache[webLog.Id] <-
webLog.RedirectRules
|> List.map (fun it ->
let relUrl = Permalink >> WebLog.relativeUrl webLog
let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
if it.IsRegex then
let pattern = if it.From.StartsWith "^" then $"^{relUrl (it.From.Substring 1)}" else it.From
RegEx (new Regex (pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
else
Text (relUrl it.From, urlTo))
/// Get all cached web logs
let all () =
@ -86,9 +108,13 @@ module WebLogCache =
/// Fill the web log cache from the database
let fill (data : IData) = backgroundTask {
let! webLogs = data.WebLog.All ()
_cache <- webLogs
webLogs |> List.iter set
}
/// Get the cached redirect rules for the given web log
let redirectRules webLogId =
_redirectCache[webLogId]
/// Is the given theme in use by any web logs?
let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)

View File

@ -26,6 +26,30 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
}
/// Middleware to check redirects for the current web log
type RedirectRuleMiddleware (next : RequestDelegate, log : ILogger<RedirectRuleMiddleware>) =
/// Shorthand for case-insensitive string equality
let ciEquals str1 str2 =
System.String.Equals (str1, str2, System.StringComparison.InvariantCultureIgnoreCase)
member _.InvokeAsync (ctx : HttpContext) = task {
let path = ctx.Request.Path.Value.ToLower ()
let matched =
WebLogCache.redirectRules ctx.WebLog.Id
|> List.tryPick (fun rule ->
match rule with
| WebLogCache.CachedRedirectRule.Text (urlFrom, urlTo) ->
log.LogInformation $"Checking {path} against from={urlFrom} and to={urlTo}"
if ciEquals path urlFrom then Some urlTo else None
| WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) ->
if regExFrom.IsMatch path then Some (regExFrom.Replace (path, patternTo)) else None)
match matched with
| Some url -> ctx.Response.Redirect (url, permanent = true)
| None -> return! next.Invoke ctx
}
open System
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.DependencyInjection
@ -207,6 +231,7 @@ let main args =
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware> ()
let _ = app.UseMiddleware<RedirectRuleMiddleware> ()
let _ = app.UseAuthentication ()
let _ = app.UseStaticFiles ()
let _ = app.UseRouting ()