From a63a096d075797f12ed614d5029e16f55a8bc769 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sat, 9 May 2026 11:48:36 +0100 Subject: Optimisations to log rendering with mustache --- cbits/escapexml.c | 49 +++++++++++++++++++++++++++++++++++++++++++++ pages/calendar-day.mustache | 12 +++++------ pages/log.mustache | 12 +++++------ src/EscapeXML.hs | 37 ++++++++++++++++++++++++++++++++++ src/Main.hs | 12 ++++++----- tirclogv.cabal | 5 ++++- 6 files changed, 109 insertions(+), 18 deletions(-) create mode 100644 cbits/escapexml.c create mode 100644 src/EscapeXML.hs diff --git a/cbits/escapexml.c b/cbits/escapexml.c new file mode 100644 index 0000000..6eb366d --- /dev/null +++ b/cbits/escapexml.c @@ -0,0 +1,49 @@ +#include +#include + +// https://hackage-content.haskell.org/package/mustache-2.4.3.1/src/src/Text/Mustache/Internal.hs +// +// escapeXML :: String -> String +// escapeXML = concatMap $ \x -> IntMap.findWithDefault [x] (ord x) mp +// where mp = IntMap.fromList [(ord b, "&"++a++";") | (a,[b]) <- xmlEntities] +// +// xmlEntities :: [(String, String)] +// xmlEntities = +// [ ("quot", "\"") +// , ("#39", "'") +// , ("amp" , "&") +// , ("lt" , "<") +// , ("gt" , ">") +// ] + +#define ENTITIES_XLIST \ + X('"', 6, """) \ + X('\'', 5, "'") \ + X('&', 5, "&") \ + X('<', 4, "<") \ + X('>', 4, ">") + +size_t tirclogv_escapexml_len(const uint8_t *src, size_t src_off, size_t src_len) { + size_t reslen = 0; + for (size_t i = 0; i < src_len; i++) { + switch (src[src_off + i]) { +#define X(ch, len, _str) case ch: reslen += len; break; + ENTITIES_XLIST +#undef X + default: reslen += 1; break; + } + } + return reslen; +} + +void tirclogv_escapexml(uint8_t *dst, const uint8_t *src, size_t src_off, size_t src_len) { + for (size_t i = 0, j = 0; i < src_len; i++) { + const uint8_t c = src[src_off + i]; + switch (c) { +#define X(ch, len, str) case ch: memcpy(&dst[j], str, len); j += len; break; + ENTITIES_XLIST +#undef X + default: dst[j++] = c; break; + } + } +} diff --git a/pages/calendar-day.mustache b/pages/calendar-day.mustache index f72f42a..3483d59 100644 --- a/pages/calendar-day.mustache +++ b/pages/calendar-day.mustache @@ -12,17 +12,17 @@
Home {{network}}/{{channel}}: - Logs - Calendar + Logs + Calendar

Logs on {{date}} ({{network}}/{{channel}})

{{#events}} - - - - + + + + {{/events}}
{{time}}{{#nickwrap1}}{{nickwrap1}}{{/nickwrap1}}{{nick}}{{#nickwrap2}}{{nickwrap2}}{{/nickwrap2}}{{message}}{{&time}}{{#nickwrap1}}{{&nickwrap1}}{{/nickwrap1}}{{&nickE}}{{#nickwrap2}}{{&nickwrap2}}{{/nickwrap2}}{{&messageE}}
diff --git a/pages/log.mustache b/pages/log.mustache index fc01310..c07eb20 100644 --- a/pages/log.mustache +++ b/pages/log.mustache @@ -12,8 +12,8 @@
Home {{network}}/{{channel}}: - Logs - Calendar + Logs + Calendar

Logs: {{network}}/{{channel}}

@@ -49,10 +49,10 @@ {{#events}} - - - - + + + + {{/events}}
{{datetime}}{{#nickwrap1}}{{nickwrap1}}{{/nickwrap1}}{{nick}}{{#nickwrap2}}{{nickwrap2}}{{/nickwrap2}}{{message}}{{&datetime}}{{#nickwrap1}}{{&nickwrap1}}{{/nickwrap1}}{{&nickE}}{{#nickwrap2}}{{&nickwrap2}}{{/nickwrap2}}{{&messageE}}
diff --git a/src/EscapeXML.hs b/src/EscapeXML.hs new file mode 100644 index 0000000..662d2ed --- /dev/null +++ b/src/EscapeXML.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +module EscapeXML (escapeXML) where + +import Data.Array.Byte +import Data.Text.Internal +import Foreign.C.Types +import GHC.Exts +import GHC.IO (IO(IO)) +import System.IO.Unsafe (unsafePerformIO) + + +foreign import ccall unsafe "tirclogv_escapexml_len" + c_escapexml_len :: ByteArray# -> CSize -> CSize -> IO CSize + +foreign import ccall unsafe "tirclogv_escapexml" + c_escapexml :: MutableByteArray# RealWorld -> ByteArray# -> CSize -> CSize -> IO () + +{-# NOINLINE escapeXML #-} +escapeXML :: Text -> Text +escapeXML (Text (ByteArray src#) off len) = unsafePerformIO $ do + let offCS = fromIntegral @Int @CSize off + lenCS = fromIntegral @Int @CSize len + + reslen <- c_escapexml_len src# offCS lenCS + let !reslenI@(I# reslen#) = fromIntegral @CSize @Int reslen + + MutableByteArray dst# <- + IO $ \s -> case newByteArray# reslen# s of + (# s', mba# #) -> (# s', MutableByteArray mba# #) + c_escapexml dst# src# offCS lenCS + ba <- IO $ \s -> case unsafeFreezeByteArray# dst# s of + (# s', ba# #) -> (# s', ByteArray ba# #) + + return (Text ba 0 reslenI) diff --git a/src/Main.hs b/src/Main.hs index c49b02d..458ed9f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} @@ -33,6 +34,7 @@ import Network.HTTP.Server.Mini.Internal.Instrument (atomicPrintS) import Calendar import Config +import EscapeXML import Index import Util import ZNC @@ -114,9 +116,9 @@ pageLog conf pages index req alias = pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s ,"linkid" ~> eid ,"nickwrap1" ~> nickw1 - ,"nick" ~> nick + ,"nickE" ~> escapeXML nick ,"nickwrap2" ~> nickw2 - ,"message" ~> msg] + ,"messageE" ~> escapeXML msg] | ((time, eid, ev), dayidx) <- zip events [0..] , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]] where @@ -157,9 +159,9 @@ pageCalendarDay conf pages index req alias datestr = in pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s ,"linkid" ~> eid ,"nickwrap1" ~> nickw1 - ,"nick" ~> nick + ,"nickE" ~> escapeXML nick ,"nickwrap2" ~> nickw2 - ,"message" ~> msg] + ,"messageE" ~> escapeXML msg] | ((time, eid, ev), dayidx) <- zip events [0..] , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]] where @@ -191,7 +193,7 @@ renderEvent = \case Part n addr reas -> (j "ev-leave", (no, "", j "←"), n <> " parts (" <> addr <> ") (" <> reas <> ")") Quit n addr reas -> (j "ev-leave", (no, "", j "×"), n <> " quits (" <> addr <> ") (" <> reas <> ")") ReNick n n' -> (j "ev-meta", (no, n, no), "is now known as " <> n') - Talk n m -> (no, (j "<", n, j ">"), m) + Talk n m -> (no, (j "<", n, j ">"), m) Notice n m -> (j "ev-notice", (j "-", n, j "-"), m) Act n m -> (j "ev-act", (no, n, no), m) Kick n by reas -> (j "ev-meta", (no, n, no), "is kicked by " <> by <> " (" <> reas <> ")") diff --git a/tirclogv.cabal b/tirclogv.cabal index ead88fb..f65130a 100644 --- a/tirclogv.cabal +++ b/tirclogv.cabal @@ -23,6 +23,7 @@ executable tirclogv Calendar Config Debounce + EscapeXML ImmutGrowVector Index Mmap @@ -46,7 +47,9 @@ executable tirclogv unix, vector hs-source-dirs: src - c-sources: cbits/mmap.c + c-sources: + cbits/mmap.c + cbits/escapexml.c ghc-options: -Wall -threaded library mini-http-server -- cgit v1.3.1