diff options
Diffstat (limited to 'src/scm/webid-oidc')
| -rw-r--r-- | src/scm/webid-oidc/hello-world.scm | 27 | ||||
| -rw-r--r-- | src/scm/webid-oidc/program.scm | 29 | ||||
| -rw-r--r-- | src/scm/webid-oidc/server/Makefile.am | 6 | ||||
| -rw-r--r-- | src/scm/webid-oidc/server/log.scm | 33 |
4 files changed, 78 insertions, 17 deletions
diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm index 9dc85cb..8e68359 100644 --- a/src/scm/webid-oidc/hello-world.scm +++ b/src/scm/webid-oidc/hello-world.scm @@ -16,6 +16,7 @@ (define-module (webid-oidc hello-world) #:use-module (webid-oidc resource-server) + #:use-module (webid-oidc server log) #:use-module (webid-oidc jti) #:use-module ((webid-oidc config) #:prefix cfg:) #:use-module (web request) @@ -48,14 +49,20 @@ (complete-corresponding-source-sym (string->symbol (G_ "command-line|complete-corresponding-source"))) (help-sym - (string->symbol (G_ "comand-line|help"))) + (string->symbol (G_ "command-line|help"))) (port-sym - (string->symbol (G_ "comand-line|port")))) + (string->symbol (G_ "command-line|port"))) + (log-file-sym + (string->symbol (G_ "command-line|log-file"))) + (error-file-sym + (string->symbol (G_ "command-line|error-file")))) (let ((options (let ((option-spec `((,complete-corresponding-source-sym (single-char #\S) (value #t)) (,version-sym (single-char #\v) (value #f)) (,help-sym (single-char #\h) (value #f)) + (,log-file-sym (single-char #\l) (value #t)) + (,error-file-sym (single-char #\e) (value #t)) (,port-sym (single-char #\p) (value #t))))) (getopt-long (command-line) option-spec)))) (cond @@ -80,12 +87,18 @@ Options: display the version information (~a) and exit. -p PORT, --~a=PORT: set the port to bind. + -l FILE.log, --~a=FILE.log: + redirect the program standard output to FILE.log. + -e FILE.err, --~a=FILE.err: + redirect the program errors to FILE.err. ") (car (command-line)) complete-corresponding-source-sym help-sym version-sym cfg:version - port-sym)) + port-sym + log-file-sym + error-file-sym)) ((option-ref options version-sym #f) (format #t (G_ "~a version ~a\n") cfg:package cfg:version)) @@ -99,7 +112,9 @@ Options: (G_ "You are legally required to link to the complete corresponding source code.\n")) (exit 1)) str)) - (jti-list (make-jti-list))) + (jti-list (make-jti-list)) + (log-file (option-ref options log-file-sym #f)) + (error-file (option-ref options error-file-sym #f))) (unless (and (string->number port-string) (integer? (string->number port-string)) (>= (string->number port-string) 0) @@ -109,6 +124,10 @@ Options: (exit 1)) (let ((handler (lambda (request request-body) + (when log-file + (prepare-log-file log-file)) + (when error-file + (prepare-error-file error-file)) (if (eq? (request-method request) 'GET) (let ((agent (assoc-ref (request-headers request) 'xxx-agent))) (if (and agent (string->uri agent)) diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index 4d431da..d4b98fe 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -16,6 +16,7 @@ (define-module (webid-oidc program) #:use-module (webid-oidc errors) + #:use-module (webid-oidc server log) #:use-module (webid-oidc reverse-proxy) #:use-module (webid-oidc identity-provider) #:use-module (webid-oidc client) @@ -62,8 +63,12 @@ (define cache-http-get (with-cache #:http-get http-get-with-log)) -(define (handler-with-log complete-corresponding-source handler) +(define (handler-with-log log-file error-file complete-corresponding-source handler) (lambda (request request-body) + (when log-file + (prepare-log-file log-file)) + (when error-file + (prepare-error-file error-file)) (call/ec (lambda (return) (with-exception-handler @@ -484,14 +489,6 @@ If you find a bug, then please send a report to ~a. help-sym) (exit 1)) (install-suspendable-ports!) - (when (option-ref options log-file-sym #f) - (set-current-output-port - (stubs:open-output-file* (option-ref options log-file-sym #f))) - (setvbuf (current-output-port) 'none)) - (when (option-ref options error-file-sym #f) - (set-current-error-port - (stubs:open-output-file* (option-ref options error-file-sym #f))) - (setvbuf (current-error-port) 'none)) (let ((command (car rest)) (non-options (cdr rest))) (cond @@ -507,6 +504,8 @@ If you find a bug, then please send a report to ~a. (exit 1)) (run-server (handler-with-log + (option-ref options log-file-sym #f) + (option-ref options error-file-sym #f) complete-corresponding-source (make-reverse-proxy #:server-uri server-name @@ -553,7 +552,10 @@ If you find a bug, then please send a report to ~a. #:current-time current-time #:http-get cache-http-get))) (run-server - (handler-with-log complete-corresponding-source handler) + (handler-with-log + (option-ref options log-file-sym #f) + (option-ref options error-file-sym #f) + complete-corresponding-source handler) 'http (list #:port port))))) ((equal? command (G_ "command-line|command|client-service")) @@ -579,7 +581,10 @@ If you find a bug, then please send a report to ~a. #:client-name client-name #:client-uri client-uri))) (run-server - (handler-with-log complete-corresponding-source handler) + (handler-with-log + (option-ref options log-file-sym #f) + (option-ref options error-file-sym #f) + complete-corresponding-source handler) 'http (list #:port port))))) ((equal? command (G_ "command-line|command|server")) @@ -641,6 +646,8 @@ If you find a bug, then please send a report to ~a. (create-root server-name subject) (run-server (handler-with-log + (option-ref options log-file-sym #f) + (option-ref options error-file-sym #f) complete-corresponding-source (lambda (request request-body) (let ((path (uri-path (request-uri request)))) diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am index 7551ff9..365b878 100644 --- a/src/scm/webid-oidc/server/Makefile.am +++ b/src/scm/webid-oidc/server/Makefile.am @@ -19,13 +19,15 @@ dist_serverwebidoidcmod_DATA += \ %reldir%/read.scm \ %reldir%/precondition.scm \ %reldir%/update.scm \ - %reldir%/delete.scm + %reldir%/delete.scm \ + %reldir%/log.scm serverwebidoidcgo_DATA += \ %reldir%/create.go \ %reldir%/read.go \ %reldir%/precondition.go \ %reldir%/update.go \ - %reldir%/delete.go + %reldir%/delete.go \ + %reldir%/log.go include %reldir%/resource/Makefile.am diff --git a/src/scm/webid-oidc/server/log.scm b/src/scm/webid-oidc/server/log.scm new file mode 100644 index 0000000..f7dfa48 --- /dev/null +++ b/src/scm/webid-oidc/server/log.scm @@ -0,0 +1,33 @@ +;; webid-oidc, implementation of the Solid specification +;; Copyright (C) 2021 Vivien Kraus + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(define-module (webid-oidc server log) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:export + ( + prepare-log-file + prepare-error-file + )) + +(define (prepare-log-file log) + (set-current-output-port + (open-file log "a")) + (setvbuf (current-output-port) 'none)) + +(define (prepare-error-file log) + (set-current-error-port + (open-file log "a")) + (setvbuf (current-error-port) 'none)) |