Add basic request logging, disabled by default

This commit is contained in:
Cadence Ember 2023-02-08 23:15:13 +13:00
parent 0ba20c9e38
commit c3c4ea9e55
Signed by untrusted user: cadence
GPG Key ID: BC1C2C61CF521B17
6 changed files with 70 additions and 5 deletions

View File

@ -61,7 +61,7 @@
"Documentation and more information"))
(p
(a (@ (href "https://lists.sr.ht/~cadence/breezewiki-discuss"))
"Discussions / Bug reports / Feature requests"))
"Chat / Bug reports / Feature requests"))
,(if (config-true? 'instance_is_official)
`(p ,(format "This instance is run by the ~a developer, " (config-get 'application_name))
(a (@ (href "https://cadence.moe/contact"))

View File

@ -39,7 +39,9 @@
(feature_offline::enabled . "false")
(feature_offline::format . "json.gz")
(feature_offline::only . "false")))
(feature_offline::only . "false")
(access_log::enabled . "false")))
(define loaded-alist
(with-handlers

54
src/log.rkt Normal file
View File

@ -0,0 +1,54 @@
#lang typed/racket/base
(require racket/file
racket/port
racket/runtime-path
racket/string
typed/srfi/19
"config.rkt")
(provide
log-page-request
log-styles-request
log-set-settings-request)
(define last-flush 0)
(define flush-every-millis 60000)
(define-runtime-path log-file "../storage/logs/access-0.log")
(define log-port
(if (config-true? 'access_log::enabled)
(begin
(make-directory* (simplify-path (build-path log-file 'up)))
(open-output-file log-file #:exists 'append))
(open-output-nowhere)))
(: get-date-iso8601 (-> String))
(define (get-date-iso8601)
(date->string (current-date 0) "~5"))
(: offline-string (Boolean -> String))
(define (offline-string offline?)
(if offline? "---" "ooo"))
(: log (String * -> Void))
(define (log . entry)
;; create log entry string
(define full-entry (cons (get-date-iso8601) entry))
;; write to output port
(displayln (string-join full-entry ";") log-port)
;; flush output port to file (don't do this too frequently)
(when ((- (current-milliseconds) last-flush) . >= . flush-every-millis)
(flush-output log-port)
(set! last-flush (current-milliseconds))))
(: log-page-request (Boolean String String (U 'light 'dark 'default) -> Void))
(define (log-page-request offline? wikiname title theme)
(log "page" (offline-string offline?) wikiname title (symbol->string theme)))
(: log-styles-request (Boolean String String -> Void))
(define (log-styles-request offline? wikiname basename)
(log "style" (offline-string offline?) wikiname basename))
(: log-set-settings-request (Symbol -> Void))
(define (log-set-settings-request theme)
(log "settings" (symbol->string theme)))

View File

@ -4,6 +4,7 @@
web-server/http
"application-globals.rkt"
"data.rkt"
"log.rkt"
"../lib/url-utils.rkt"
"../lib/xexpr-utils.rkt")
@ -14,5 +15,6 @@
(response-handler
(define next-location (dict-ref (url-query (request-uri req)) 'next_location))
(define new-settings (read (open-input-string (dict-ref (url-query (request-uri req)) 'new_settings))))
(log-set-settings-request (user-cookies^-theme new-settings))
(define headers (user-cookies-setter new-settings))
(generate-redirect next-location #:headers headers)))

View File

@ -12,7 +12,8 @@
"../archiver/archiver.rkt"
"../lib/mime-types.rkt"
"../lib/xexpr-utils.rkt"
"../src/config.rkt")
"config.rkt"
"log.rkt")
(provide
page-static-archive)
@ -53,6 +54,7 @@
(define (handle-style wikiname dest)
(when (config-true? 'debug)
(printf "using offline mode for style ~a ~a~n" wikiname dest))
(log-styles-request #t wikiname dest)
(define fs-path (build-path path-archive wikiname "styles" dest))
(println fs-path)
(unless (file-exists? fs-path)

View File

@ -22,6 +22,7 @@
"application-globals.rkt"
"config.rkt"
"data.rkt"
"log.rkt"
"page-wiki.rkt"
"../lib/archive-file-mappings.rkt"
"../lib/pure-utils.rkt"
@ -47,6 +48,12 @@
(define maybe-hashed-basename (if ((string-length basename) . > . 240)
(sha1 (string->bytes/latin-1 basename))
basename))
(define user-cookies (user-cookies-getter req))
(define theme (user-cookies^-theme user-cookies))
(log-page-request #t wikiname maybe-hashed-basename theme)
(define archive-format
(case (config-get 'feature_offline::format)
[(".json" "json") (cons "~a.json" (λ () (read-json)))]
@ -98,8 +105,6 @@
(define original-page (html->xexp (preprocess-html-wiki (jp "/parse/text" data))))
(define page ((query-selector (λ (t a c) (has-class? "mw-parser-output" a)) original-page)))
(define initial-head-data ((head-data-getter wikiname) data))
(define user-cookies (user-cookies-getter req))
(define theme (user-cookies^-theme user-cookies))
(define head-data
(case theme
[(light dark)