diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/EscapeXML.hs | 37 | ||||
| -rw-r--r-- | src/Main.hs | 12 |
2 files changed, 44 insertions, 5 deletions
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 <> ")") |