-
Notifications
You must be signed in to change notification settings - Fork 1
/
loganal.ss
156 lines (134 loc) · 4.75 KB
/
loganal.ss
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
(module loganal mzscheme
(require (lib "pregexp.ss"))
(require (lib "32.ss" "srfi"))
(require (prefix s1: (lib "1.ss" "srfi")))
(require (planet "aif.ss" ("schematics" "macro.plt" 1)))
(require (lib "dns" "net"))
(define *places* 25)
(define selector-hash (make-hash-table 'equal))
(define ip-hash (make-hash-table 'equal))
(define month-hash (make-hash-table 'equal))
(define toplevel-hash (make-hash-table 'equal))
(define regex-date (pregexp "(\\d{4})-(\\d{2})-(\\d{2}) (\\d{2}):(\\d{2}):(\\d{2})"))
(define regex-toplevel (pregexp "([^/]*).*"))
(define regex-tab (pregexp "\t"))
(define-struct month-entry (hits days))
(define (hashinc! hash key)
(let ((val (hash-table-get hash key 0)))
(hash-table-put! hash key (+ 1 val))))
(define (processline type date ip selector . args)
(apply
(lambda (year month day h m s)
(let ((monthspec (string-append year "-" month)))
(aif ent (hash-table-get month-hash monthspec #f)
(begin
(set-month-entry-hits!
ent (+ 1 (month-entry-hits ent)))
(vector-set!
(month-entry-days ent) (- (string->number day) 1)
(vector-ref
(month-entry-days ent) (- (string->number day) 1))))
(begin
(hash-table-put!
month-hash monthspec
(make-month-entry
1
(let ((v (make-vector 31)))
(vector-set! v (string->number day) 1)
v))))))
(hashinc! selector-hash selector)
(hashinc! toplevel-hash (pregexp-replace regex-toplevel selector "\\1"))
(hashinc! ip-hash ip))
(cdr (pregexp-match regex-date date))))
(define (nextline)
(let ((l (read-line)))
(when (not (eof-object? l))
(apply processline (pregexp-split regex-tab l))
(nextline))))
(define (hash-top hash n)
(let* ((l (list-sort
(lambda (a1 b1)
(> (cdr a1) (cdr b1)))
(hash-table-map hash (lambda (k v) (cons k v)))))
(ll (length l)))
(s1:take l (if (< n ll) n ll))))
(define (writemult str cnt)
(let wr ((c cnt))
(display str)
(if (> c 1) (wr (- c 1)))))
(define (row-print format row)
(let field ((tcell row)
(fcell format))
(when (pair? tcell)
(let ((sl (string-length (car tcell)))
(just (caar fcell))
(len (cadar fcell)))
(if (equal? 'l just)
(begin
(display (car tcell))
(if (< sl len)
(writemult " " (- len sl))))
(begin
(if (< sl len)
(writemult " " (- len sl)))
(display (car tcell))))
(display " ")
(field (cdr tcell) (cdr fcell)))))
(display "\n"))
(define (table-lengths table)
(map (lambda (col)
(apply max
(map (lambda (row)
(string-length (list-ref row col)))
table)))
(s1:iota (length (car table)))))
(define (table-print format table)
(let* ((lengths (table-lengths table))
(form (map (lambda (f l) (list f l)) format lengths)))
(for-each (lambda (row)
(row-print form row))
table)))
(define (place-table top)
(table-print
'(r r l)
(map (lambda (place row)
(list (string-append (number->string (+ 1 place)) ".")
(number->string (cdr row))
(car row)))
(s1:iota (length top))
top)))
(define (host-name n)
(pregexp-replace "^::ffff:" n ""))
(nextline)
(display "\nMonthly hits:\n")
(table-print
'(l r)
(map (lambda (month)
(list
month
(number->string
(month-entry-hits (hash-table-get month-hash month)))))
(list-sort
(lambda (a b) (string<? a b))
(hash-table-map month-hash (lambda (k v) k)))))
(display "\nTop selectors:\n")
(place-table (hash-top selector-hash *places*))
(display "\nToplevels:\n")
(place-table (hash-top toplevel-hash 10))
(display "\nTop hosts:\n")
(let ((dns (dns-find-nameserver))
(top (hash-top ip-hash *places*)))
(table-print
'(r r l l)
(map (lambda (place row)
(let ((name (host-name (car row))))
(list (string-append (number->string (+ 1 place)) ".")
(number->string (cdr row))
name
(with-handlers
((exn? (lambda (exn) "?")))
(sleep 0.2)
(dns-get-name dns name)))))
(s1:iota (length top))
top)))
)