159 lines
7 KiB
Scheme
159 lines
7 KiB
Scheme
;;; config.scm
|
|
|
|
;; Code for dealing with configuration options, both within the configuration
|
|
;; file, and through command-line flags
|
|
|
|
;; TODO: Figure out how to parse the configuration format in doc/config.scm
|
|
;; TODO: Most of the command-line options will need to be parsed from a string
|
|
;; into an actual native data type
|
|
|
|
(define-module (config)
|
|
#:export (build-options/command-line
|
|
build-options make-options options?
|
|
options-host-uri
|
|
options-certificate
|
|
options-private-key
|
|
options-database
|
|
options-configuration
|
|
options-templates
|
|
set-options-templates!
|
|
options-allowed-file-types
|
|
options-max-file-size
|
|
options-registrations?
|
|
options-token
|
|
options-anonymous-upload?
|
|
options-anonymous-modify-tags?
|
|
options-anonymous-comment?
|
|
options-anonymous-vote?
|
|
options-anonymous-view?
|
|
options-upload-rate
|
|
options-modify-tags-rate
|
|
options-comment-rate
|
|
options-vote-rate
|
|
options-view-rate))
|
|
|
|
(use-modules (srfi srfi-9)
|
|
(ice-9 getopt-long)
|
|
(web uri))
|
|
|
|
|
|
(define-record-type <options>
|
|
;; The options record definitions
|
|
(make-options host-uri
|
|
certificate private-key
|
|
database configuration templates
|
|
allowed-file-types max-file-size
|
|
registrations? token
|
|
anonymous-upload? anonymous-modify-tags?
|
|
anonymous-comment? anonymous-vote? anonymous-view?
|
|
upload-rate modify-tags-rate
|
|
comment-rate vote-rate view-rate)
|
|
options?
|
|
(host-uri options-host-uri)
|
|
(certificate options-certificate)
|
|
(private-key options-private-key)
|
|
(database options-database)
|
|
(configuration options-configuration)
|
|
(templates options-templates set-options-templates!)
|
|
(allowed-file-types options-allowed-file-types)
|
|
(max-file-size options-max-file-size)
|
|
(registrations? options-registrations?)
|
|
(token options-token)
|
|
(anonymous-upload? options-anonymous-upload?)
|
|
(anonymous-modify-tags? options-anonymous-modify-tags?)
|
|
(anonymous-comment? options-anonymous-comment?)
|
|
(anonymous-vote? options-anonymous-vote?)
|
|
(anonymous-view? options-anonymous-view?)
|
|
(upload-rate options-upload-rate)
|
|
(modify-tags-rate options-modify-tags-rate)
|
|
(comment-rate options-comment-rate)
|
|
(vote-rate options-vote-rate)
|
|
(view-rate options-view-rate))
|
|
|
|
|
|
(define (print-help) (format #t "TODO: Put something here\n"))
|
|
(define (print-version) (format #t "TODO: Put something here\n"))
|
|
|
|
|
|
(define* (build-options/command-line #:optional (command-line (command-line)))
|
|
;; Parse the command line options into an options record
|
|
|
|
(define option-specification
|
|
'((server-name (single-char #\n) (value #t) (required? #t))
|
|
(certificate (single-char #\c) (value #t) (required? #t))
|
|
(private-key (single-char #\k) (value #t) (required? #t))
|
|
(port (single-char #\p) (value #t))
|
|
(database (single-char #\d) (value #t))
|
|
(configuration (single-char #\C) (value #t))
|
|
(templates (single-char #\T) (value #t))
|
|
(allowed-file-types (single-char #\f) (value #t))
|
|
(max-file-size (single-char #\s) (value #t))
|
|
(registrations (single-char #\r))
|
|
(token (single-char #\t) (value #t))
|
|
(help (single-char #\h))
|
|
(version (single-char #\v))))
|
|
|
|
(define (optargs->options optargs)
|
|
;; Convert the value returned by getopt-long into a list of function
|
|
;; argments that can be applied to build-options directly
|
|
(let ((sentinel (gensym))
|
|
(option-names '((server-name . #:server-name)
|
|
(port . #:port)
|
|
(certificate . #:certificate)
|
|
(private-key . #:private-key)
|
|
(database . #:database)
|
|
(configuration . #:configuration)
|
|
(templates . #:templates)
|
|
(allowed-file-types . #:allowed-file-types)
|
|
(registrations . #:registrations?)
|
|
(token . #:token))))
|
|
(define (name->kwarg name)
|
|
;; Convert the optarg option name into the keyword name and its
|
|
;; corresponding value (or a sentinel value, if unspecified)
|
|
(list (cdr name) (option-ref optargs (car name) sentinel)))
|
|
|
|
(define (absent? kwarg)
|
|
;; Filter arguments that weren't actually specified
|
|
(not (eq? sentinel (cadr kwarg))))
|
|
|
|
;; Match optargs to key/value, filter absent values, then flatten
|
|
;; the list so we can just directly apply it
|
|
(apply append (filter absent? (map name->kwarg option-names)))))
|
|
|
|
(let ((arguments (getopt-long command-line option-specification)))
|
|
(cond ((option-ref arguments 'help #f) (print-help))
|
|
((option-ref arguments 'version #f) (print-version))
|
|
(else (apply build-options (optargs->options arguments))))))
|
|
|
|
|
|
(define* (build-options #:key server-name certificate private-key
|
|
(port 1965)
|
|
(database "/var/lib/gembooru")
|
|
(configuration "/etc/gembooru/config.scm")
|
|
(templates "/etc/gembooru/template.scm")
|
|
(allowed-file-types '("image/png" "image/jpeg"
|
|
"image/gif" "video/webm"))
|
|
(max-file-size 10) ; TODO units
|
|
(registrations? #f)
|
|
(token #f)
|
|
(anonymous-upload? #f)
|
|
(anonymous-modify-tags? #f)
|
|
(anonymous-comment? #f)
|
|
(anonymous-vote? #f)
|
|
(anonymous-view? #f)
|
|
(upload-rate 2)
|
|
(modify-tags-rate 5)
|
|
(comment-rate 10)
|
|
(vote-rate 20)
|
|
(view-rate 100))
|
|
;; Higher-level interface to create options records, with default values for
|
|
;; all but the bare minimum
|
|
(let ((uri (build-uri-reference #:host server-name #:port port)))
|
|
(make-options uri certificate private-key
|
|
database configuration templates
|
|
allowed-file-types max-file-size
|
|
registrations? token
|
|
anonymous-upload? anonymous-modify-tags?
|
|
anonymous-comment? anonymous-vote? anonymous-view?
|
|
upload-rate modify-tags-rate
|
|
comment-rate vote-rate view-rate)))
|