+ (sort msgs (λ (a b) (cmp (Msg-ts-epoch a)
+ (Msg-ts-epoch b)))))
+
+(: paths->peers (-> (Listof String) (Listof Peer)))
+(define (paths->peers paths)
+ (let* ([paths (match paths
+ ['()
+ (let ([peer-refs-file (build-path tt-home-dir "peers")])
+ (log-debug
+ "No peer ref file paths provided, defaulting to ~v"
+ (path->string peer-refs-file))
+ (list peer-refs-file))]
+ [paths
+ (log-debug "Peer ref file paths provided: ~v" paths)
+ (map string->path paths)])]
+ [peers (append* (map file->peers paths))])
+ (log-info "Read-in ~a peers." (length peers))
+ (uniq peers)))
+
+(: mentioned-peers-in-cache (-> (Listof Peer)))
+(define (mentioned-peers-in-cache)
+ (define msgs
+ (append* (map (λ (filename)
+ (define path (build-path cache-object-dir filename))
+ (define size (/ (file-size path) 1000000.0))
+ (log-info "BEGIN parsing ~a MB from file: ~v"
+ size
+ (path->string path))
+ (define t0 (current-inexact-milliseconds))
+ (define m (filter-map
+ (λ (line)
+ (str->msg #f (cache-object-filename->url filename) line))
+ (filter-comments
+ (file->lines path))))
+ (define t1 (current-inexact-milliseconds))
+ (log-info "END parsing ~a MB in ~a seconds from file: ~v."
+ size
+ (* 0.001 (- t1 t0))
+ (path->string path))
+ (when (empty? m)
+ (log-warning "No messages found in ~a" (path->string path)))
+ m)
+ (directory-list cache-object-dir))))
+ (uniq (append* (map Msg-mentions msgs))))
+
+(: follower->peer (-> Follower Peer))
+(define/match (follower->peer f)
+ [((Follower n u _ _)) (Peer n u)])
+
+(: weblog-line->follower (-> String (Option Peer)))
+(define weblog-line->follower
+ (let ([re #px"([^/]+)/([^ ]+) +\\(\\+([a-z]+://[^;]+); *@([^\\)]+)\\)"])
+ (λ (log-line)
+ (match (regexp-match re log-line)
+ [(list _ client version uri nick)
+ (let ([f (Follower nick (string->url uri) client version)])
+ (log-debug "Found follower: ~v" f)
+ f) ]
+ [_ #f]))))
+
+(define (weblog-file->peers file-path)
+ (define size (/ (file-size file-path) 1000000.0))
+ (log-info "BEGIN parsing ~a MB from file: ~v" size (path->string file-path))
+ (define t0 (current-inexact-milliseconds))
+ (define peers
+ (let* ([prefilter-cmd-path
+ (build-path tt-home-dir "hooks" "web-log-prefilter")]
+ [lines
+ (match (process* prefilter-cmd-path file-path)
+ [(list in _out pid err ctrl)
+ (ctrl 'wait)
+ (match (ctrl 'exit-code)
+ [(or 0 1) ; Assuming grep's: 0: found, 1: not found, 2: error
+ (port->lines in)]
+ [_
+ (log-warning "Prefilter hook failed: ~a" (port->string err))
+ (file->lines file-path)])])])
+ (map follower->peer (filter-map weblog-line->follower lines))))
+ (define t1 (current-inexact-milliseconds))
+ (log-info "END parsing ~a MB in ~a seconds from file: ~v."
+ size
+ (* 0.001 (- t1 t0))
+ (path->string file-path))
+ (when (empty? peers)
+ (log-warning "No peers found in ~a" (path->string file-path)))
+ (uniq peers))
+
+(define (weblog-dir->peers dir-path)
+ (uniq (append*
+ (map weblog-file->peers
+ (filter-map
+ (λ (filename)
+ (define file-path (build-path dir-path filename))
+ (if (equal? 'file (file-or-directory-type file-path))
+ file-path
+ #f))
+ (if (directory-exists? dir-path)
+ (directory-list dir-path)
+ '()))))))
+
+(define (follower-peers-in-web-logs log-dirs)
+ (uniq (append* (map weblog-dir->peers log-dirs))))
+
+(: log-writer-stop (-> Thread Void))
+(define (log-writer-stop log-writer)
+ (log-message (current-logger) 'fatal 'stop "Exiting." #f)
+ (thread-wait log-writer))
+
+(: log-writer-start (-> Log-Level Thread))
+(define (log-writer-start level)
+ (let* ([logger
+ (make-logger #f #f level #f)]
+ [log-receiver
+ (make-log-receiver logger level)]
+ [log-writer
+ (thread
+ (λ ()
+ (parameterize
+ ([date-display-format 'iso-8601])
+ (let loop ()
+ (match-define (vector level msg _ topic) (sync log-receiver))
+ (unless (equal? topic 'stop)
+ (eprintf "~a [~a] ~a~n" (date->string (current-date) #t) level msg)
+ (loop))))))])
+ (current-logger logger)
+ log-writer))