regex-examples-0.7.0.0: examples/re-nginx-log-processor.lhs
Example: NGINX Log Processor
============================
This example program reads lines from NGINX error-log files and
access-log files converts them into a unified output format.
It is an example of developing REs at scale using macros with
the regex test bench.
The tool is self-testing: run it with no arguments (or `cabal test`).
\begin{code}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
-- development
, parse_a
, parse_e
) where
import Control.Applicative
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Lazy as HML
import Data.Functor.Identity
import Data.Maybe
import Data.String
import qualified Data.Text as T
import Data.Time
import Prelude.Compat
import qualified Shelly as SH
import System.Directory
import System.Environment
import System.Exit
import System.IO
import Text.RE.Tools.Sed
import Text.RE.Types.Options
import Text.RE.TestBench.Parsers
import Text.RE.TestBench
import Text.RE.PCRE.ByteString.Lazy
import qualified Text.RE.PCRE.String as S
import Text.Printf
\end{code}
\begin{code}
main :: IO ()
main = do
as <- getArgs
case as of
["--macro" ] -> putStr lp_macro_table
["--macro",mid_s] -> putStrLn $ lp_macro_summary $ MacroID mid_s
["--regex" ] -> putStr lp_macro_sources
["--regex",mid_s] -> putStrLn $ lp_macro_source $ MacroID mid_s
["--test" ] -> test
[] -> test
[in_file ] | is_file in_file -> go True in_file "-"
[in_file,out_file ] | is_file in_file -> go True in_file out_file
_ -> usage
where
is_file = not . (== "--") . take 2
usage = do
pnm <- getProgName
let prg = ((pnm++" ")++)
putStr $ unlines
[ "usage:"
, prg " --help"
, prg " --macro"
, prg " --macro <macro-id>"
, prg " --regex"
, prg " --regex <macro-id>"
, prg "[--test]"
, prg "(-|<in-file>) [-|<out-fileß>]"
]
\end{code}
\begin{code}
--
-- go
--
test :: IO ()
test = do
putStrLn "============================================================"
putStrLn "Testing the macro environment."
putStrLn "nginx-log-processor"
dumpMacroTable "nginx-log-processor" regexType lp_env
me_ok <- testMacroEnv "nginx-log-processor" regexType lp_env
putStrLn "============================================================"
putStrLn "Testing the log processor on reference data."
putStrLn ""
lp_ok <- test_log_processor
putStrLn "============================================================"
case me_ok && lp_ok of
True -> return ()
False -> exitWith $ ExitFailure 1
test_log_processor :: IO Bool
test_log_processor = do
createDirectoryIfMissing False "tmp"
go False "data/access-errors.log" "tmp/events.log"
cmp "tmp/events.log" "data/events.log"
\end{code}
\begin{code}
--
-- go
--
go :: Bool -> FilePath -> FilePath -> IO ()
go rprt_flg in_file out_file = do
ctx <- setup rprt_flg
sed (script ctx) in_file out_file
\end{code}
\begin{code}
script :: Ctx -> SedScript RE
script ctx = Select
[ on [re_|@{access}|] ACC parse_access
, on [re_|@{access_deg}|] AQQ parse_deg_access
, on [re_|@{error}|] ERR parse_error
, on [re_|.*|] QQQ parse_def
]
where
on rex src prs =
(,) (rex lpo) $ Function TOP $ process_line ctx src prs
parse_def = fmap capturedText . matchCapture
\end{code}
\begin{code}
process_line :: IsEvent a
=> Ctx
-> Source
-> (Match LBS.ByteString->Maybe a)
-> LineNo
-> Match LBS.ByteString
-> Location
-> Capture LBS.ByteString
-> IO (Maybe LBS.ByteString)
process_line ctx src prs lno cs _ _ = do
when (event_is_notifiable event) $
flag_event ctx event
return $ Just $ presentEvent event
where
event = maybe def_event (mkEvent lno src) $ prs cs
def_event =
Event
{ _event_line = lno
, _event_source = src
, _event_utc = read "1970-01-01 00:00:00"
, _event_severity = Nothing
, _event_address = (0,0,0,0)
, _event_details = ""
}
--
-- Ctx, setup, event_is_notifiable, flag_event
--
type Ctx = Bool
setup :: Bool -> IO Ctx
setup = return
event_is_notifiable :: Event -> Bool
event_is_notifiable Event{..} =
fromEnum (fromMaybe Debug _event_severity) <= fromEnum Err
flag_event :: Ctx -> Event -> IO ()
flag_event False = const $ return ()
flag_event True = LBS.hPutStrLn stderr . presentEvent
--
-- Event, presentEvent, IsEvent
--
data Event =
Event
{ _event_line :: LineNo
, _event_source :: Source
, _event_utc :: UTCTime
, _event_severity :: Maybe Severity
, _event_address :: IPV4Address
, _event_details :: LBS.ByteString
}
deriving (Show)
data Source = ACC | AQQ | ERR | QQQ
deriving (Show,Read)
presentEvent :: Event -> LBS.ByteString
presentEvent Event{..} = LBS.pack $
printf "%04d %s %s %-7s %3d.%3d.%3d.%3d [%s]"
(getLineNo _event_line )
(show _event_source )
(show _event_utc )
(maybe "-" svrty_kw _event_severity)
a b c d
(LBS.unpack _event_details )
where
(a,b,c,d) = _event_address
svrty_kw = T.unpack . fst . severityKeywords
class IsEvent a where
mkEvent :: LineNo -> Source -> a -> Event
instance IsEvent Access where
mkEvent lno src Access{..} =
Event
{ _event_line = lno
, _event_source = src
, _event_utc = _a_time_local
, _event_severity = Nothing
, _event_address = _a_remote_addr
, _event_details = LBS.pack $
printf "%s %d %d %s %s %s"
(T.unpack _a_request )
_a_status
_a_body_bytes
(T.unpack _a_http_referrer )
(T.unpack _a_http_user_agent)
(T.unpack _a_other )
}
instance IsEvent Error where
mkEvent lno src ERROR{..} =
Event
{ _event_line = lno
, _event_source = src
, _event_utc = UTCTime _e_date $ timeOfDayToTime _e_time
, _event_severity = Just _e_severity
, _event_address = (0,0,0,0)
, _event_details = LBS.pack $ printf "%d#%d: %s" pid tid $ LBS.unpack _e_other
}
where
(pid,tid) = _e_pid_tid
instance IsEvent LBS.ByteString where
mkEvent lno src lbs =
Event
{ _event_line = lno
, _event_source = src
, _event_utc = read "1970-01-01 00:00:00"
, _event_severity = Nothing
, _event_address = (0,0,0,0)
, _event_details = lbs
}
--
-- Options and Prelude
--
lpo :: Options
lpo = makeOptions lp_prelude
lp_prelude :: Macros RE
lp_prelude = runIdentity $ mkMacros mk regexType ExclCaptures lp_env
where
mk = maybe oops Identity . compileRegexWithOptions noPreludeOptions
oops = error "lp_prelude"
lp_macro_table :: String
lp_macro_table = formatMacroTable regexType lp_env
lp_macro_summary :: MacroID -> String
lp_macro_summary = formatMacroSummary regexType lp_env
lp_macro_sources :: String
lp_macro_sources = formatMacroSources regexType ExclCaptures lp_env
lp_macro_source :: MacroID -> String
lp_macro_source = formatMacroSource regexType ExclCaptures lp_env
lp_env :: MacroEnv
lp_env = preludeEnv `HML.union` HML.fromList
[ f "user" user_macro
, f "pid#tid:" pid_tid_macro
, f "access" access_macro
, f "access_deg" access_deg_macro
, f "error" error_macro
]
where
f mid mk = (mid, mk lp_env mid)
--
-- The Macro Descriptors
--
user_macro :: MacroEnv -> MacroID -> MacroDescriptor
user_macro env mid =
runTests regexType parse_user samples env mid
MacroDescriptor
{ _md_source = "(?:-|[^[:space:]]+)"
, _md_samples = map fst samples
, _md_counter_samples = counter_samples
, _md_test_results = []
, _md_parser = Just "parse_user"
, _md_description = "a user ident (per RFC1413)"
}
where
samples :: [(String,User)]
samples =
[ f "joe"
]
where
f nm = (nm,User $ LBS.pack nm)
counter_samples =
[ "joe user"
]
pid_tid_macro :: MacroEnv -> MacroID -> MacroDescriptor
pid_tid_macro env mid =
runTests regexType parse_pid_tid samples env mid
MacroDescriptor
{ _md_source = "(?:@{%nat})#(?:@{%nat}):"
, _md_samples = map fst samples
, _md_counter_samples = counter_samples
, _md_test_results = []
, _md_parser = Just "parse_pid_tid"
, _md_description = "<PID>#<TID>:"
}
where
samples :: [(String,(Int,Int))]
samples =
[ f "1378#0:" (1378,0)
]
where
f = (,)
counter_samples =
[ ""
, "24#:"
, "24.365:"
]
access_macro :: MacroEnv -> MacroID -> MacroDescriptor
access_macro env mid =
runTests' regexType (parse_access . fmap LBS.pack) samples env mid
MacroDescriptor
{ _md_source = access_re
, _md_samples = map fst samples
, _md_counter_samples = counter_samples
, _md_test_results = []
, _md_parser = Just "parse_a"
, _md_description = "an Nginx access log file line"
}
where
samples :: [(String,Access)]
samples =
[ (,) "192.168.100.200 - - [12/Jan/2016:12:08:36 +0000] \"GET / HTTP/1.1\" 200 3700 \"-\" \"My Agent\" \"-\""
Access
{ _a_remote_addr = (192,168,100,200)
, _a_remote_user = "-"
, _a_time_local = read "2016-01-12 12:08:36 UTC"
, _a_request = "GET / HTTP/1.1"
, _a_status = 200
, _a_body_bytes = 3700
, _a_http_referrer = "-"
, _a_http_user_agent = "My Agent"
, _a_other = "-"
}
]
counter_samples =
[ ""
, " - [] \"\" \"\" \"\" \"\""
]
access_deg_macro :: MacroEnv -> MacroID -> MacroDescriptor
access_deg_macro env mid =
runTests' regexType (parse_deg_access . fmap LBS.pack) samples env mid
MacroDescriptor
{ _md_source = " - \\[\\] \"\" \"\" \"\" \"\""
, _md_samples = map fst samples
, _md_counter_samples = counter_samples
, _md_test_results = []
, _md_parser = Nothing
, _md_description = "a degenerate Nginx access log file line"
}
where
samples :: [(String,Access)]
samples =
[ (,) " - [] \"\" \"\" \"\" \"\"" deg_access
]
counter_samples =
[ ""
, "foo"
]
error_macro :: MacroEnv -> MacroID -> MacroDescriptor
error_macro env mid =
runTests' regexType (parse_error . fmap LBS.pack) samples env mid
MacroDescriptor
{ _md_source = error_re
, _md_samples = map fst samples
, _md_counter_samples = counter_samples
, _md_test_results = []
, _md_parser = Just "parse_e"
, _md_description = "an Nginx error log file line"
}
where
samples :: [(String,Error)]
samples =
[ (,) "2016/12/21 11:53:35 [emerg] 1378#0: foo"
ERROR
{ _e_date = read "2016-12-21"
, _e_time = read "11:53:35"
, _e_severity = Emerg
, _e_pid_tid = (1378,0)
, _e_other = " foo"
}
, (,) "2017/01/04 05:40:19 [error] 31623#0: *1861296 no \"ssl_certificate\" is defined in server listening on SSL port while SSL handshaking, client: 192.168.31.38, server: 0.0.0.0:80"
ERROR
{ _e_date = read "2017-01-04"
, _e_time = read "05:40:19"
, _e_severity = Err
, _e_pid_tid = (31623,0)
, _e_other = " *1861296 no \"ssl_certificate\" is defined in server listening on SSL port while SSL handshaking, client: 192.168.31.38, server: 0.0.0.0:80"
}
]
counter_samples =
[ ""
, "foo"
]
\end{code}
\begin{code}
--
-- Access, access_re, deg_access, parse_deg_access, parse_access
--
data Access =
Access
{ _a_remote_addr :: !IPV4Address
, _a_remote_user :: !User
, _a_time_local :: !UTCTime
, _a_request :: !T.Text
, _a_status :: !Int
, _a_body_bytes :: !Int
, _a_http_referrer :: !T.Text
, _a_http_user_agent :: !T.Text
, _a_other :: !T.Text
}
deriving (Eq,Show)
\end{code}
\begin{code}
access_re :: RegexSource
access_re = RegexSource $ unwords
[ "(@{%address.ipv4})"
, "-"
, "(@{user})"
, "\\[(@{%datetime.clf})\\]"
, "(@{%string.simple})"
, "(@{%nat})"
, "(@{%nat})"
, "(@{%string.simple})"
, "(@{%string.simple})"
, "(@{%string.simple})"
]
\end{code}
\begin{code}
deg_access :: Access
deg_access =
Access
{ _a_remote_addr = (0,0,0,0)
, _a_remote_user = "-"
, _a_time_local = read "1970-01-01 00:00:00"
, _a_request = ""
, _a_status = 0
, _a_body_bytes = 0
, _a_http_referrer = ""
, _a_http_user_agent = ""
, _a_other = ""
}
parse_deg_access :: Match LBS.ByteString -> Maybe Access
parse_deg_access Match{..} =
case matchSource == " - [] \"\" \"\" \"\" \"\"" of
True -> Just deg_access
False -> Nothing
parse_a :: LBS.ByteString -> Maybe Access
parse_a lbs = parse_access $ lbs ?=~ [re_|@{access}|] lpo
parse_access :: Match LBS.ByteString -> Maybe Access
parse_access cs =
Access
<$> f parseIPv4Address [cp|1|]
<*> f parse_user [cp|2|]
<*> f parseDateTimeCLF [cp|3|]
<*> f parseSimpleString [cp|4|]
<*> f parseInteger [cp|5|]
<*> f parseInteger [cp|6|]
<*> f parseSimpleString [cp|7|]
<*> f parseSimpleString [cp|8|]
<*> f parseSimpleString [cp|9|]
where
f psr i = psr $ capturedText $ capture i cs
--
-- Error, error_re, parse_error
--
data Error =
ERROR
{ _e_date :: Day
, _e_time :: TimeOfDay
, _e_severity :: Severity
, _e_pid_tid :: (Int,Int)
, _e_other :: LBS.ByteString
}
deriving (Eq,Show)
error_re :: RegexSource
error_re = RegexSource $ unwords
[ "(@{%date.slashes})"
, "(@{%time})"
, "\\[(@{%syslog.severity})\\]"
, "(@{pid#tid:})(.*)"
]
parse_e :: LBS.ByteString -> Maybe Error
parse_e lbs = parse_error $ lbs ?=~ [re_|@{error}|] lpo
parse_error :: Match LBS.ByteString -> Maybe Error
parse_error cs =
ERROR
<$> f parseSlashesDate [cp|1|]
<*> f parseTimeOfDay [cp|2|]
<*> f parseSeverity [cp|3|]
<*> f parse_pid_tid [cp|4|]
<*> f Just [cp|5|]
where
f psr i = psr $ capturedText $ capture i cs
--
-- User, parseUser
--
newtype User =
User { _User :: LBS.ByteString }
deriving (IsString,Ord,Eq,Show)
parse_user :: Replace a => a -> Maybe User
parse_user = Just . User . LBS.pack . unpackE
--
-- parse_pid_tid
--
parse_pid_tid :: Replace a => a -> Maybe (Int,Int)
parse_pid_tid x = case allMatches $ unpackE x S.*=~ [re|@{%nat}|] of
[cs,cs'] -> (,) <$> p cs <*> p cs'
_ -> Nothing
where
p cs = matchCapture cs >>= parseInteger . capturedText
--
-- cmp
--
cmp :: T.Text -> T.Text -> IO Bool
cmp src dst = handle hdl $ do
_ <- SH.shelly $ SH.verbosely $
SH.run "cmp" [src,dst]
return True
where
hdl :: SomeException -> IO Bool
hdl se = do
hPutStrLn stderr $
"testing results against model answers failed: " ++ show se
return False
\end{code}