diff options
Diffstat (limited to 'src/scm/webid-oidc/hello-world.scm')
| -rw-r--r-- | src/scm/webid-oidc/hello-world.scm | 49 |
1 files changed, 44 insertions, 5 deletions
diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm index cda88e4..9dc85cb 100644 --- a/src/scm/webid-oidc/hello-world.scm +++ b/src/scm/webid-oidc/hello-world.scm @@ -1,3 +1,19 @@ +;; webid-oidc, implementation of the Solid specification +;; Copyright (C) 2020, 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 hello-world) #:use-module (webid-oidc resource-server) #:use-module (webid-oidc jti) @@ -29,13 +45,16 @@ (textdomain cfg:package) (let ((version-sym (string->symbol (G_ "command-line|version"))) + (complete-corresponding-source-sym + (string->symbol (G_ "command-line|complete-corresponding-source"))) (help-sym (string->symbol (G_ "comand-line|help"))) (port-sym (string->symbol (G_ "comand-line|port")))) (let ((options (let ((option-spec - `((,version-sym (single-char #\v) (value #f)) + `((,complete-corresponding-source-sym (single-char #\S) (value #t)) + (,version-sym (single-char #\v) (value #f)) (,help-sym (single-char #\h) (value #f)) (,port-sym (single-char #\p) (value #t))))) (getopt-long (command-line) option-spec)))) @@ -45,15 +64,25 @@ Display your identity contained in the XXX-Agent header. +This program is covered by the GNU Affero GPL, version 3 or +later. This license requires you to provide a way for any user over +the network to download the complete corresponding source code (with +your modifications) at no cost. The server adds a \"Source:\" header +to all responses. + Options: + -S MEANS, --~a=MEANS: + specify a way to download the complete corresponding source + code. For instance, this would be an URI pointing to a tarball. -h, --~a: display this help message and exit. -v, --~a: display the version information (~a) and exit. - -p PORT, --port=~a: + -p PORT, --~a=PORT: set the port to bind. ") (car (command-line)) + complete-corresponding-source-sym help-sym version-sym cfg:version port-sym)) @@ -63,6 +92,13 @@ Options: (else (let ((port-string (option-ref options port-sym "8080")) + (means-string + (let ((str (option-ref options complete-corresponding-source-sym #f))) + (unless str + (format (current-error-port) + (G_ "You are legally required to link to the complete corresponding source code.\n")) + (exit 1)) + str)) (jti-list (make-jti-list))) (unless (and (string->number port-string) (integer? (string->number port-string)) @@ -78,7 +114,8 @@ Options: (if (and agent (string->uri agent)) (values (build-response - #:headers '((content-type application/xhtml+xml))) + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) (with-output-to-string (lambda () (sxml->xml @@ -92,7 +129,8 @@ Options: (values (build-response #:code 401 #:reason-phrase "Unauthorized" - #:headers '((content-type application/xhtml+xml))) + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) (with-output-to-string (lambda () (sxml->xml @@ -104,7 +142,8 @@ Options: (values (build-response #:code 405 #:reason-phrase "Method Not Allowed" - #:headers '((content-type application/xhtml+xml))) + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) (with-output-to-string (lambda () (sxml->xml |