diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index ea4a2c7..0b4f28a 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -45,7 +45,7 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration" module Cache = // POST /admin/cache/web-log/{id}/refresh - let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data if webLogId = "all" then do! WebLogCache.fill data @@ -68,7 +68,7 @@ module Cache = } // POST /admin/cache/theme/{id}/refresh - let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data if themeId = "all" then Template.Cache.empty () @@ -120,7 +120,7 @@ module Category = } // POST /admin/category/save - let save : HttpHandler = fun next ctx -> task { + let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync() let category = @@ -193,7 +193,7 @@ module RedirectRules = } // POST /admin/settings/redirect-rules/[index] - let save idx : HttpHandler = fun next ctx -> task { + let save idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let rule = model.ToRule() let rules = @@ -208,7 +208,7 @@ module RedirectRules = } // POST /admin/settings/redirect-rules/[index]/up - let moveUp idx : HttpHandler = fun next ctx -> task { + let moveUp idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then return! Error.notFound next ctx else @@ -219,7 +219,7 @@ module RedirectRules = } // POST /admin/settings/redirect-rules/[index]/down - let moveDown idx : HttpHandler = fun next ctx -> task { + let moveDown idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then return! Error.notFound next ctx else @@ -230,7 +230,7 @@ module RedirectRules = } // DELETE /admin/settings/redirect-rules/[index] - let delete idx : HttpHandler = fun next ctx -> task { + let delete idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then return! Error.notFound next ctx else @@ -265,7 +265,7 @@ module TagMapping = } // POST /admin/settings/tag-mapping/save - let save : HttpHandler = fun next ctx -> task { + let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync() let tagMap = @@ -280,7 +280,7 @@ module TagMapping = } // DELETE /admin/settings/tag-mapping/{id} - let delete tagMapId : HttpHandler = fun next ctx -> task { + let delete tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with | true -> do! addMessage ctx { UserMessage.Success with Message = "Tag mapping deleted successfully" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Tag mapping not found; nothing deleted" } @@ -383,7 +383,7 @@ module Theme = } // POST /admin/theme/new - let save : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let save : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task { if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then let themeFile = Seq.head ctx.Request.Form.Files match deriveIdFromFileName themeFile.FileName with @@ -424,7 +424,7 @@ module Theme = } // POST /admin/theme/{id}/delete - let delete themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let delete themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data match themeId with | "admin" | "default" -> @@ -468,7 +468,7 @@ module WebLog = } // POST /admin/settings - let saveSettings : HttpHandler = fun next ctx -> task { + let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync() match! data.WebLog.FindById ctx.WebLog.Id with diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 55df0ab..6c6365b 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -64,8 +64,8 @@ let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\ /// XML namespaces for building RSS feeds [] -module private Namespace = - +module private Namespace = + /// Enables encoded (HTML) content let content = "http://purl.org/rss/1.0/modules/content/" @@ -77,14 +77,14 @@ module private Namespace = /// Podcast Index (AKA "podcasting 2.0") let podcast = "https://podcastindex.org/namespace/1.0" - + /// Enables chapters let psc = "http://podlove.org/simple-chapters/" /// Enables another "subscribe" option let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/" -/// Create a feed item from the given post +/// Create a feed item from the given post let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list) (post: Post) = let plainText = @@ -97,9 +97,9 @@ let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayC LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(), Content = TextSyndicationContent.CreatePlaintextContent plainText) item.AddPermalink (Uri item.Id) - + let xmlDoc = XmlDocument() - + let encoded = let txt = post.Text @@ -109,7 +109,7 @@ let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayC let _ = it.AppendChild(xmlDoc.CreateCDataSection txt) it item.ElementExtensions.Add encoded - + item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value)) [ post.CategoryIds |> List.map (fun catId -> @@ -142,7 +142,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog let epExplicit = string (defaultArg episode.Explicit podcast.Explicit) - + let xmlDoc = XmlDocument() let enclosure = let it = xmlDoc.CreateElement "enclosure" @@ -154,7 +154,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes) it.SetAttribute("href", epImageUrl) it - + item.ElementExtensions.Add enclosure item.ElementExtensions.Add image item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor) @@ -162,7 +162,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit) episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it)) episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it)) - + let chapterUrl, chapterMimeType = match episode.Chapters, episode.ChapterFile with | Some _, _ -> @@ -175,7 +175,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis | None -> None Some (toAbsolute webLog chapters), typ | None, None -> None, None - + match chapterUrl with | Some url -> let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast) @@ -183,7 +183,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis chapterMimeType |> Option.iter (fun it -> elt.SetAttribute("type", it)) item.ElementExtensions.Add elt | None -> () - + match episode.TranscriptUrl with | Some transcript -> let url = toAbsolute webLog transcript @@ -194,7 +194,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions") item.ElementExtensions.Add elt | None -> () - + match episode.SeasonNumber with | Some season -> match episode.SeasonDescription with @@ -205,7 +205,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis item.ElementExtensions.Add elt | None -> item.ElementExtensions.Add("season", Namespace.podcast, string season) | None -> () - + match episode.EpisodeNumber with | Some epNumber -> match episode.EpisodeDescription with @@ -216,12 +216,12 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis item.ElementExtensions.Add elt | None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber) | None -> () - + if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then try let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc) chapters.SetAttribute("version", "1.2") - + post.Metadata |> List.filter (fun it -> it.Name = "chapter") |> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..]) @@ -231,11 +231,11 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss") chapter.SetAttribute("title", snd chap) chapters.AppendChild chapter |> ignore) - + item.ElementExtensions.Add chapters with _ -> () item - + /// Add a namespace to the feed let private addNamespace (feed: SyndicationFeed) alias nsUrl = feed.AttributeExtensions.Add(XmlQualifiedName(alias, "http://www.w3.org/2000/xmlns/"), nsUrl) @@ -248,16 +248,16 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom |> elt.AppendChild child.InnerText <- value elt - + let podcast = Option.get feed.Podcast let feedUrl = webLog.AbsoluteUrl feed.Path let imageUrl = match podcast.ImageUrl with | Permalink link when link.StartsWith "http" -> link | Permalink _ -> webLog.AbsoluteUrl podcast.ImageUrl - + let xmlDoc = XmlDocument() - + [ "dc", Namespace.dc "itunes", Namespace.iTunes "podcast", Namespace.podcast @@ -265,7 +265,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom "rawvoice", Namespace.rawVoice ] |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl) - + let categorization = let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes) it.SetAttribute("text", podcast.AppleCategory) @@ -275,7 +275,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom subCatElt.SetAttribute("text", subCat) it.AppendChild subCatElt |> ignore) it - let image = + let image = [ "title", podcast.Title "url", imageUrl "link", feedUrl @@ -296,7 +296,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom it.SetAttribute("feed", feedUrl) it.SetAttribute("itunes", "") it - + rssFeed.ElementExtensions.Add image rssFeed.ElementExtensions.Add owner rssFeed.ElementExtensions.Add categorization @@ -328,7 +328,7 @@ let private selfAndLink webLog feedType ctx = match feed.Source with | Category (CategoryId catId) -> feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}" - | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" + | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" /// Set the title and description of the feed based on its source let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCategory[]) (feed: SyndicationFeed) = @@ -358,8 +358,8 @@ let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCateg | Tag tag -> feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" - -/// Create a feed with a known non-zero-length list of posts + +/// Create a feed with a known non-zero-length list of posts let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask { let webLog = ctx.WebLog let data = ctx.Data @@ -368,7 +368,7 @@ let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgr let cats = CategoryCache.get ctx let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None let self, link = selfAndLink webLog feedType ctx - + let toItem post = let item = toFeedItem webLog authors cats tagMaps post match podcast, post.Episode with @@ -377,32 +377,32 @@ let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgr warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media" item | _ -> item - + let feed = SyndicationFeed() addNamespace feed "content" Namespace.content setTitleAndDescription feedType webLog cats feed - + feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset() feed.Generator <- ctx.Generator feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Language <- "en" feed.Id <- webLog.AbsoluteUrl link webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) - + feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L)) feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link) - + podcast |> Option.iter (addPodcast webLog feed) - + use mem = new MemoryStream() use xml = XmlWriter.Create mem feed.SaveAsRss20 xml xml.Close() - + let _ = mem.Seek(0L, SeekOrigin.Begin) let rdr = new StreamReader(mem) let! output = rdr.ReadToEndAsync() - + return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx } @@ -416,7 +416,7 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back // ~~ FEED ADMINISTRATION ~~ // POST /admin/settings/rss -let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { +let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync() match! data.WebLog.FindById ctx.WebLog.Id with @@ -457,7 +457,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next | None -> Error.notFound next ctx // POST /admin/settings/rss/save -let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { +let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 0e47a95..fa95a1d 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -62,7 +62,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> } // POST /admin/page/permalinks -let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let pageId = PageId model.Id match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with @@ -121,7 +121,7 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun } // POST /admin/page/{id}/revision/{revision-date}/restore -let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with | Some pg, Some rev when canEdit pg.AuthorId ctx -> do! ctx.Data.Page.Update @@ -148,7 +148,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun } // POST /admin/page/save -let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data let now = Noda.now () diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index d48cb28..8ac3908 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -98,7 +98,7 @@ open Giraffe // GET /page/{pageNbr}[/] let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { - if ctx.Request.Path.Value.EndsWith "/" then + if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx else let count = ctx.WebLog.PostsPerPage @@ -310,7 +310,7 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx } // POST /admin/post/permalinks -let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let postId = PostId model.Id match! ctx.Data.Post.FindById postId ctx.WebLog.Id with @@ -370,7 +370,7 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f } // POST /admin/post/{id}/revision/{revision-date}/restore -let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update @@ -431,7 +431,7 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex } // POST /admin/post/{id}/chapter/{idx} -let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let data = ctx.Data match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post @@ -483,7 +483,7 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n } // POST /admin/post/save -let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data let tryPost = diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 190e426..acadacd 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -20,6 +20,7 @@ module CatchAll = let await it = (Async.AwaitTask >> Async.RunSynchronously) it seq { // Static file + // TODO: static file middleware may take care of this now that we're setting the path base debug (fun () -> $"Considering URL {textLink}") let staticFileName = [ ctx.GetWebHostEnvironment().ContentRootPath @@ -113,91 +114,21 @@ module Asset = } -/// The primary myWebLog router -let router : HttpHandler = choose [ - subRoute "/admin" (requireUser >=> choose [ - POST >=> validateCsrf >=> choose [ - subRoute "/cache" (choose [ - routef "/theme/%s/refresh" Admin.Cache.refreshTheme - routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog - ]) - subRoute "/category" (requireAccess WebLogAdmin >=> choose [ - route "/save" >=> Admin.Category.save - routef "/%s/delete" Admin.Category.delete - ]) - route "/my-info" >=> User.saveMyInfo - subRoute "/page" (choose [ - route "/save" >=> Page.save - route "/permalinks" >=> Page.savePermalinks - routef "/%s/revision/%s/restore" Page.restoreRevision - ]) - subRoute "/post" (choose [ - route "/save" >=> Post.save - route "/permalinks" >=> Post.savePermalinks - routef "/%s/chapter/%i" Post.saveChapter - routef "/%s/revision/%s/restore" Post.restoreRevision - ]) - subRoute "/settings" (requireAccess WebLogAdmin >=> choose [ - route "" >=> Admin.WebLog.saveSettings - subRoute "/rss" (choose [ - route "" >=> Feed.saveSettings - route "/save" >=> Feed.saveCustomFeed - ]) - subRoute "/redirect-rules" (choose [ - routef "/%i" Admin.RedirectRules.save - routef "/%i/up" Admin.RedirectRules.moveUp - routef "/%i/down" Admin.RedirectRules.moveDown - ]) - route "/tag-mapping/save" >=> Admin.TagMapping.save - route "/user/save" >=> User.save - ]) - subRoute "/theme" (choose [ - route "/new" >=> Admin.Theme.save - routef "/%s/delete" Admin.Theme.delete - ]) - route "/upload/save" >=> Upload.save - ] - DELETE >=> choose [ - routef "/category/%s" Admin.Category.delete - subRoute "/page" (choose [ - routef "/%s" Page.delete - routef "/%s/revision/%s" Page.deleteRevision - routef "/%s/revisions" Page.purgeRevisions - ]) - subRoute "/post" (choose [ - routef "/%s" Post.delete - routef "/%s/chapter/%i" Post.deleteChapter - routef "/%s/revision/%s" Post.deleteRevision - routef "/%s/revisions" Post.purgeRevisions - ]) - subRoute "/settings" (requireAccess WebLogAdmin >=> choose [ - routef "/redirect-rules/%i" Admin.RedirectRules.delete - routef "/rss/%s" Feed.deleteCustomFeed - routef "/tag-mapping/%s" Admin.TagMapping.delete - routef "/user/%s" User.delete - ]) - subRoute "/upload" (requireAccess WebLogAdmin >=> choose [ - routexp "/disk/(.*)" Upload.deleteFromDisk - routef "/%s" Upload.deleteFromDb - ]) - ] - ]) - GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts - GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts - GET_HEAD >=> routexp "/themes/(.*)" Asset.serve - GET_HEAD >=> routexp "/upload/(.*)" Upload.serve - subRoute "/user" (choose [ - POST >=> validateCsrf >=> choose [ - route "/log-on" >=> User.doLogOn - ] - ]) - GET_HEAD >=> CatchAll.route - //Error.notFound +/// Router to deal with regex routes and routes served by pages, posts, and feeds +let regexRouter: HttpHandler = choose [ + DELETE >=> routexp "/admin/upload/disk/(.*)" Upload.deleteFromDisk + GET_HEAD >=> choose [ + routexp "/category/(.*)" Post.pageOfCategorizedPosts + routexp "/tag/(.*)" Post.pageOfTaggedPosts + routexp "/themes/(.*)" Asset.serve + routexp "/upload/(.*)" Upload.serve + CatchAll.route + ] ] open Giraffe.EndpointRouting -/// Endpoint-routed handler to deal with sub-routes +/// The primary myWebLog routes / endpoints let endpoints = [ GET_HEAD [ route "/" Post.home ] subRoute "/admin" [ @@ -252,13 +183,73 @@ let endpoints = [ route "/new" Upload.showNew ] ] + POST [ + subRoute "/cache" [ + routef "/theme/%s/refresh" Admin.Cache.refreshTheme + routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog + ] + route "/category/save" Admin.Category.save + route "/my-info" User.saveMyInfo + subRoute "/page" [ + route "/save" Page.save + route "/permalinks" Page.savePermalinks + routef "/%s/revision/%s/restore" Page.restoreRevision + ] + subRoute "/post" [ + route "/save" Post.save + route "/permalinks" Post.savePermalinks + routef "/%s/chapter/%i" Post.saveChapter + routef "/%s/revision/%s/restore" Post.restoreRevision + ] + subRoute "/settings" [ + route "" Admin.WebLog.saveSettings + subRoute "/rss" [ + route "" Feed.saveSettings + route "/save" Feed.saveCustomFeed + ] + subRoute "/redirect-rules" [ + routef "/%i" Admin.RedirectRules.save + routef "/%i/up" Admin.RedirectRules.moveUp + routef "/%i/down" Admin.RedirectRules.moveDown + ] + route "/tag-mapping/save" Admin.TagMapping.save + route "/user/save" User.save + ] + subRoute "/theme" [ + route "/new" Admin.Theme.save + routef "/%s/delete" Admin.Theme.delete + ] + route "/upload/save" Upload.save + ] + DELETE [ + routef "/category/%s" Admin.Category.delete + subRoute "/page" [ + routef "/%s" Page.delete + routef "/%s/revision/%s" Page.deleteRevision + routef "/%s/revisions" Page.purgeRevisions + ] + subRoute "/post" [ + routef "/%s" Post.delete + routef "/%s/chapter/%i" Post.deleteChapter + routef "/%s/revision/%s" Post.deleteRevision + routef "/%s/revisions" Post.purgeRevisions + ] + subRoute "/settings" [ + routef "/redirect-rules/%i" Admin.RedirectRules.delete + routef "/rss/%s" Feed.deleteCustomFeed + routef "/tag-mapping/%s" Admin.TagMapping.delete + routef "/user/%s" User.delete + ] + routef "/upload/%s" Upload.deleteFromDb + ] ] subRoute "/user" [ GET_HEAD [ route "/log-on" (User.logOn None) ] POST [ route "/log-off" User.logOff + route "/log-on" User.doLogOn ] ] GET_HEAD [ routef "/page/%i" Post.pageOfPosts ] - route "{**url}" router + route "{**url}" regexRouter ] diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 29a7ce2..d5c39e6 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -8,9 +8,9 @@ open Microsoft.Net.Http.Headers /// Helper functions for this module [] module private Helpers = - + open Microsoft.AspNetCore.StaticFiles - + /// A MIME type mapper instance to use when serving files from the database let mimeMap = FileExtensionContentTypeProvider() @@ -19,10 +19,10 @@ module private Helpers = let hdr = CacheControlHeaderValue() hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable hdr - + /// Shorthand for the directory separator let slash = Path.DirectorySeparatorChar - + /// The base directory where uploads are stored, relative to the executable let uploadDir = Path.Combine("wwwroot", "upload") @@ -128,7 +128,7 @@ let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> adminPage "Upload a File" next ctx Views.WebLog.uploadNew // POST /admin/upload/save -let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then let upload = Seq.head ctx.Request.Form.Files let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), @@ -138,7 +138,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let year = localNow.ToString "yyyy" let month = localNow.ToString "MM" let! form = ctx.BindFormAsync() - + match UploadDestination.Parse form.Destination with | Database -> use stream = new MemoryStream() @@ -155,7 +155,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let _ = Directory.CreateDirectory fullPath use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create) do! upload.CopyToAsync stream - + do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" } return! redirectToGet "admin/uploads" next ctx else @@ -163,7 +163,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { } // DELETE /admin/upload/{id} -let deleteFromDb upId : HttpHandler = fun next ctx -> task { +let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with | Ok fileName -> do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" } @@ -181,9 +181,9 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) = Directory.Delete fullPath path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) else finished <- true - + // DELETE /admin/upload/disk/{**path} -let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task { +let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let filePath = urlParts |> Seq.skip 1 |> Seq.head let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath) if File.Exists path then diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index e1152ae..3a4026e 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -43,7 +43,7 @@ open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication.Cookies // POST /user/log-on -let doLogOn : HttpHandler = fun next ctx -> task { +let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id @@ -111,7 +111,7 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas } // DELETE /admin/settings/user/{id} -let delete userId : HttpHandler = fun next ctx -> task { +let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with | Some user -> @@ -144,7 +144,7 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { } // POST /admin/my-info -let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { +let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with @@ -172,7 +172,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { #nowarn "3511" // POST /admin/settings/user/save -let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { +let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data let tryUser = diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 74163bb..f83ab00 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -22,7 +22,7 @@ type WebLogMiddleware(next: RequestDelegate, log: ILogger) = if CategoryCache.exists ctx then () else do! CategoryCache.update ctx if webLog.ExtraPath <> "" then ctx.Request.PathBase <- PathString(webLog.ExtraPath) - ctx.Request.Path <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..]) + ctx.Request.Path <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..]) return! next.Invoke ctx | None -> if isDebug then log.LogDebug $"No resolved web log for {path}" @@ -235,15 +235,16 @@ let main args = let _ = app.UseForwardedHeaders() (app.Services.GetRequiredService().GetSection "CanonicalDomains").Value - |> (isNull >> not) + |> isNotNull |> function true -> app.UseCanonicalDomains() |> ignore | false -> () let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseMiddleware() let _ = app.UseMiddleware() let _ = app.UseAuthentication() - let _ = app.UseStaticFiles() let _ = app.UseRouting() + let _ = app.UseStaticFiles() + //let _ = app.MapStaticAssets() let _ = app.UseSession() let _ = app.UseGiraffe Handlers.Routes.endpoints