diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 0484940..87fa88e 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -421,6 +421,11 @@ let private updateAssets themeId (zip : ZipArchive) conn = backgroundTask { } conn } +/// Get the theme name from the file name given +let getThemeName (fileName : string) = + let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-") + if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then Some themeName else None + /// Load a theme from the given stream, which should contain a ZIP archive let loadThemeFromZip themeName file clean conn = backgroundTask { use zip = new ZipArchive (file, ZipArchiveMode.Read) @@ -441,9 +446,9 @@ let loadThemeFromZip themeName file clean conn = backgroundTask { let updateTheme : HttpHandler = fun next ctx -> task { if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then let themeFile = Seq.head ctx.Request.Form.Files - let themeName = themeFile.FileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-") - // TODO: add restriction for admin theme based on role - if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then + match getThemeName themeFile.FileName with + | Some themeName -> + // TODO: add restriction for admin theme based on role let conn = ctx.Conn use stream = new MemoryStream () do! themeFile.CopyToAsync stream @@ -451,8 +456,8 @@ let updateTheme : HttpHandler = fun next ctx -> task { do! ThemeAssetCache.refreshTheme (ThemeId themeName) conn do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" } return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx - else - do! addMessage ctx { UserMessage.error with message = $"Theme name {themeName} is invalid" } + | None -> + do! addMessage ctx { UserMessage.error with message = $"Theme file name {themeFile.FileName} is invalid" } return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx else return! RequestErrors.BAD_REQUEST "Bad request" next ctx diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 311e46a..aa9856d 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -1,12 +1,10 @@ module MyWebLog.Maintenance open System -open Microsoft.Extensions.DependencyInjection -open RethinkDb.Driver.Net - - open System.IO +open Microsoft.Extensions.DependencyInjection open RethinkDb.Driver.FSharp +open RethinkDb.Driver.Net /// Create the web log information let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { @@ -76,10 +74,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { /// Create a new web log let createWebLog args sp = task { match args |> Array.length with - | 5 -> return! doCreateWebLog args sp - | _ -> - printfn "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" - return! System.Threading.Tasks.Task.CompletedTask + | 5 -> do! doCreateWebLog args sp + | _ -> printfn "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" } /// Import prior permalinks from a text files with lines in the format "[old] [new]" @@ -117,10 +113,27 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task { } /// Import permalinks if all is well -let importPermalinks args sp = task { +let importLinks args sp = task { match args |> Array.length with - | 3 -> return! importPriorPermalinks args[1] args[2] sp - | _ -> - printfn "Usage: MyWebLog import-permalinks [url] [file-name]" - return! System.Threading.Tasks.Task.CompletedTask + | 3 -> do! importPriorPermalinks args[1] args[2] sp + | _ -> printfn "Usage: MyWebLog import-links [url] [file-name]" +} + +/// Load a theme from the given ZIP file +let loadTheme (args : string[]) (sp : IServiceProvider) = task { + if args.Length > 1 then + match Handlers.Admin.getThemeName args[1] with + | Some themeName -> + let conn = sp.GetRequiredService () + let clean = if args.Length > 2 then bool.Parse args[2] else true + use stream = File.Open (args[1], FileMode.Open) + use copy = new MemoryStream () + do! stream.CopyToAsync copy + do! Handlers.Admin.loadThemeFromZip themeName copy clean conn + printfn $"Theme {themeName} loaded successfully" + | None -> + printfn $"Theme file name {args[1]} is invalid" + else + printfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]" + printfn " * optional, defaults to true" } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 8e51246..bd0fcb5 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -85,10 +85,9 @@ let main args = let app = builder.Build () match args |> Array.tryHead with - | Some it when it = "init" -> - Maintenance.createWebLog args app.Services |> Async.AwaitTask |> Async.RunSynchronously - | Some it when it = "import-permalinks" -> - Maintenance.importPermalinks args app.Services |> Async.AwaitTask |> Async.RunSynchronously + | Some it when it = "init" -> Maintenance.createWebLog args app.Services + | Some it when it = "import-links" -> Maintenance.importLinks args app.Services + | Some it when it = "load-theme" -> Maintenance.loadTheme args app.Services | _ -> let _ = app.UseForwardedHeaders () let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) @@ -99,7 +98,7 @@ let main args = let _ = app.UseSession () let _ = app.UseGiraffe Handlers.Routes.endpoint - app.Run() - + System.Threading.Tasks.Task.FromResult (app.Run ()) + |> Async.AwaitTask |> Async.RunSynchronously + 0 // Exit code -