Verified Commit ba5a6253 authored by Camil Staps's avatar Camil Staps 🚀

New and improved logging system (resolves #41)

parent 2ec5974c
......@@ -9,7 +9,7 @@ import StdOverloaded
import StdString
import StdTuple
from StdFunc import const, flip, id, o, seq
from StdMisc import abort
from StdMisc import abort, undef
from TCPIP import :: IPAddress, :: Port, instance toString IPAddress
......@@ -442,28 +442,65 @@ where
loc :: Location -> LocationResult
loc (Location lib mod ln iln _) = (lib, mod, ln, iln)
log :: (LogMessage (Maybe Request) Response CacheKey) IPAddress *World
-> *(IPAddress, *World)
log msg s w
| not needslog = (newS msg s, w)
# (tm,w) = localTime w
# (io,w) = stdio w
# io = io <<< trim (toString tm) <<< " " <<< msgToString msg s
= (newS msg s, snd (fclose io w))
where
needslog = case msg of (Received _) = True; (Sent _ _) = True; _ = False
newS :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> IPAddress
newS m s = case m of (Connected ip) = ip; _ = s
msgToString :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> String
msgToString (Received Nothing) ip
= toString ip + " <-- Nothing\n"
msgToString (Received (Just a)) ip
= toString ip + " <-- " + toString a + "\n"
msgToString (Sent {return,data,msg,more_available} ck) ip
= toString ip + " --> " + toString (length data)
+ " results (" + toString return + "; " + msg
+ if (isJust more_available) ("; " + toString (fromJust more_available) + " more") ""
+ "; cache: " + ck + ")\n"
msgToString _ _ = ""
:: LogMemory =
{ mem_ip :: IPAddress
, mem_time_start :: Tm
, mem_time_end :: Tm
, mem_request :: Request
}
instance zero LogMemory
where
zero =
{ mem_ip = undef
, mem_time_start = undef
, mem_time_end = undef
, mem_request = undef
}
:: LogMessage` :== LogMessage (Maybe Request) Response CacheKey
:: LogEntry =
{ ip :: String
, time_start :: (String, Int)
, time_end :: (String, Int)
, request :: Request
, cachekey :: String
, response_code :: Int
, results :: Int
}
derive JSONEncode LogEntry
log :: LogMessage` (Maybe LogMemory) *World -> *(Maybe LogMemory, *World)
log msg mem w
# mem = fromJust (mem <|> pure zero)
# (mem,w) = updateMemory msg mem w
| not needslog = (Just mem, w)
# (io,w) = stdio w
# io = io <<< msgToString msg mem <<< "\n"
= (Just mem, snd (fclose io w))
where
needslog = case msg of (Sent _ _) = True; _ = False
updateMemory :: LogMessage` LogMemory *World -> *(LogMemory, *World)
updateMemory (Connected ip) s w = ({s & mem_ip=ip}, w)
updateMemory (Received (Just r)) s w
# (t,w) = localTime w
= ({s & mem_time_start=t, mem_request=r}, w)
updateMemory (Sent _ _) s w
# (t,w) = localTime w
= ({s & mem_time_end=t}, w)
updateMemory _ s w = (s,w)
msgToString :: LogMessage` LogMemory -> String
msgToString (Sent response ck) mem
= toString $ toJSON
{ ip = toString mem.mem_ip
, time_start = (toString mem.mem_time_start, toInt $ mkTime mem.mem_time_start)
, time_end = (toString mem.mem_time_end, toInt $ mkTime mem.mem_time_end)
, request = mem.mem_request
, cachekey = ck
, response_code = response.return
, results = length response.data
}
......@@ -9,7 +9,7 @@ from TCPIP import ::IPAddress, ::Port
| Sent b t
| Disconnected
:: Logger a b s t :== (LogMessage a b t) s *World -> *(s, *World)
:: Logger a b s t :== (LogMessage a b t) (Maybe s) *World -> *(Maybe s, *World)
serve :: (a *World -> *(b,t,*World)) (Maybe (Logger a b s t)) Port *World
-> *World | fromString a & toString b
......@@ -24,7 +24,7 @@ where
-> (TCP_Listener, *World) | fromString a & toString b
loop f log li w
#! ((ip,dupChan),li,w) = receive li w
#! (st,w) = log (Connected ip) undef w
#! (st,w) = log (Connected ip) Nothing w
# (pid,w) = fork w
| pid < 0
= abort "fork failed\n"
......@@ -34,7 +34,7 @@ where
// Child: handle current request
= handle f log st dupChan w
handle :: (a *World-> (b,t,*World)) (Logger a b s t) !s !TCP_DuplexChannel
handle :: (a *World-> (b,t,*World)) (Logger a b s t) !(Maybe !s) !TCP_DuplexChannel
!*World -> (TCP_Listener, *World) | fromString a & toString b
handle f log st dupChannel=:{rChannel,sChannel} w
# (tRep,msg,rChannel,w) = receive_MT TIMEOUT rChannel w
......
var util = require('util');
var fs = require('fs');
var spawn = require('child_process').spawn;
var WebSocketServer = require('websocket').server;
var filename = process.argv[2];
if (!filename)
return util.puts("Usage: node server.js <LOG> [<SSL_CERT> <SSL_KEY>]");
return console.log("Usage: node server.js <LOG> [<SSL_CERT> <SSL_KEY>]");
if (process.argv.length >= 5) {
https = require('https');
......@@ -32,17 +31,14 @@ var ws = new WebSocketServer({
ws.on('request', function(req){
var con = req.accept('cloogle-stats', req.origin);
var tail = spawn("tail", ["-n", "2", "-f", filename]);
var tail = spawn("tail", ["-n", "1", "-f", filename]);
con.on('close', function(reason, desc){
tail.kill();
});
tail.stdout.on('data', function(data){
var match = /<-- (\{.*\})/.exec(data);
if (match != null && !match[1].match(/u[0-9a-f]{4}/)) {
console.log(match[1]);
con.sendUTF(match[1]);
}
data = JSON.parse(data);
con.sendUTF(JSON.stringify(data['request']));
});
});
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment