Return 404 if page URLs have extra content at the end

This commit is contained in:
Daniel J. Summers 2022-05-18 20:42:12 -04:00
parent 20b7ba1150
commit 7b69fe9439
2 changed files with 49 additions and 41 deletions

View File

@ -9,7 +9,11 @@ open Microsoft.AspNetCore.Http
let private pathAndPageNumber (ctx : HttpContext) = let private pathAndPageNumber (ctx : HttpContext) =
let slugs = (string ctx.Request.RouteValues["slug"]).Split "/" |> Array.filter (fun it -> it <> "") let slugs = (string ctx.Request.RouteValues["slug"]).Split "/" |> Array.filter (fun it -> it <> "")
let pageIdx = Array.IndexOf (slugs, "page") let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr = if pageIdx > 0 then (int64 slugs[pageIdx + 1]) else 1L let pageNbr =
match pageIdx with
| -1 -> Some 1L
| idx when idx + 2 = slugs.Length -> Some (int64 slugs[pageIdx + 1])
| _ -> None
let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs
pageNbr, String.Join ("/", slugParts) pageNbr, String.Join ("/", slugParts)
@ -101,27 +105,29 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
// GET /category/{slug}/ // GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr} // GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts : HttpHandler = fun next ctx -> task { let pageOfCategorizedPosts : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
let conn = conn ctx let conn = conn ctx
let pageNbr, slug = pathAndPageNumber ctx match pathAndPageNumber ctx with
let allCats = CategoryCache.get ctx | Some pageNbr, slug ->
let cat = allCats |> Array.find (fun cat -> cat.slug = slug) let allCats = CategoryCache.get ctx
// Category pages include posts in subcategories let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
let catIds = // Category pages include posts in subcategories
allCats let catIds =
|> Seq.ofArray allCats
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames) |> Seq.ofArray
|> Seq.map (fun c -> CategoryId c.id) |> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> List.ofSeq |> Seq.map (fun c -> CategoryId c.id)
match! Data.Post.findPageOfCategorizedPosts webLog.id catIds pageNbr webLog.postsPerPage conn with |> List.ofSeq
| posts when List.length posts > 0 -> match! Data.Post.findPageOfCategorizedPosts webLog.id catIds pageNbr webLog.postsPerPage conn with
let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx conn | posts when List.length posts > 0 ->
let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>""" let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx conn
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}") let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("subtitle", cat.description.Value) hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("is_category", true) hash.Add ("subtitle", cat.description.Value)
return! themedView "index" next ctx hash hash.Add ("is_category", true)
| _ -> return! Error.notFound next ctx return! themedView "index" next ctx hash
| _ -> return! Error.notFound next ctx
| None, _ -> return! Error.notFound next ctx
} }
open System.Web open System.Web
@ -129,25 +135,27 @@ open System.Web
// GET /tag/{tag}/ // GET /tag/{tag}/
// GET /tag/{tag}/page/{pageNbr} // GET /tag/{tag}/page/{pageNbr}
let pageOfTaggedPosts : HttpHandler = fun next ctx -> task { let pageOfTaggedPosts : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
let conn = conn ctx let conn = conn ctx
let pageNbr, rawTag = pathAndPageNumber ctx match pathAndPageNumber ctx with
let tag = HttpUtility.UrlDecode rawTag | Some pageNbr, rawTag ->
match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with let tag = HttpUtility.UrlDecode rawTag
| posts when List.length posts > 0 -> match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
return! themedView "index" next ctx hash
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
let spacedTag = tag.Replace ("-", " ")
match! Data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 conn with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1L then "" else $"page/{pageNbr}" let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
return! redirectTo true $"""/tag/{spacedTag.Replace (" ", "+")}/{endUrl}""" next ctx let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
| _ -> return! Error.notFound next ctx hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
return! themedView "index" next ctx hash
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
let spacedTag = tag.Replace ("-", " ")
match! Data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 conn with
| posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1L then "" else $"page/{pageNbr}"
return! redirectTo true $"""/tag/{spacedTag.Replace (" ", "+")}/{endUrl}""" next ctx
| _ -> return! Error.notFound next ctx
| None, _ -> return! Error.notFound next ctx
} }
// GET / // GET /

View File

@ -3,5 +3,5 @@
"hostname": "data02.bitbadger.solutions", "hostname": "data02.bitbadger.solutions",
"database": "myWebLog_dev" "database": "myWebLog_dev"
}, },
"Generator": "myWebLog 2.0-alpha03" "Generator": "myWebLog 2.0-alpha04"
} }