diff options
Diffstat (limited to 'module/calp')
-rw-r--r-- | module/calp/server/webdav.scm | 38 | ||||
-rw-r--r-- | module/calp/webdav/resource/virtual.scm | 3 |
2 files changed, 40 insertions, 1 deletions
diff --git a/module/calp/server/webdav.scm b/module/calp/server/webdav.scm index 7cbdd32e..3413f254 100644 --- a/module/calp/server/webdav.scm +++ b/module/calp/server/webdav.scm @@ -131,6 +131,7 @@ +;;; Extract the root element from sxml tree (define (root-element sxml) (sxml-match sxml [(*TOP* (*PI* . ,args) ,root) root] @@ -471,15 +472,37 @@ +;;; Log tables are tables for easily adding key value data, +;;; and later formatting them. +;;; They in themself do not actually do any logging. + +;;; The "global" log table (define log-table (make-parameter #f)) + +;;; Initialize the global log table to an empty log table (define (init-log-table!) (log-table '())) + +;;; Takes a list of alternating symbols and values, +;;; Each such pair is added to the log global table (define (log-table-add! . args) (for (key value) in (group args 2) (log-table (acons key value (log-table))))) + +;;; Get the given key from the global key table +;;; or return dflt (default #f) if not found (define* (log-table-get key optional: dflt) (or (assoc-ref (log-table) key) dflt)) +;;; Write data from the global log table to current output port. +;;; Each argument should be one of the following types +;;; string? :: printed verbatim +;;; symbol? :: value looked up in the global log table, +;;; and value printed +;;; pair? :: The car is a symbol to look up per `symbol?' +;;; The cdr is a procedure for foramtting the given +;;; value for output +;;; All other types are ignored. (define (log-table-format . args) (for-each (lambda (arg) (cond ((string? arg) (display arg)) @@ -490,6 +513,21 @@ (else #f))) args)) +;;; Writes a log message to current error port. +;;; This reads values for the log table. +;;; +;;; The following table fields are used +;;; now :: current datetime, as a datetime? +;;; method :: Name of the source method +;;; uri :: URI accessed, an an uri? object +;;; request :: The source request +;;; If the request-method of the request is +;;; 'COPY or 'MOVE then `headers' is checked for a +;;; destination header. +;;; headers :: Request headers, see `request' +;;; response-code :: Response code to emit (e.x. 200) +;;; response-phrase :: Phrase belonging to that code (e.x. "OK") +;;; msg :: Optional freetext message (define (emit-log!) ;; (write (log-table) (current-error-port)) ;; (newline (current-error-port)) diff --git a/module/calp/webdav/resource/virtual.scm b/module/calp/webdav/resource/virtual.scm index 1d2d5d31..42ffc123 100644 --- a/module/calp/webdav/resource/virtual.scm +++ b/module/calp/webdav/resource/virtual.scm @@ -38,7 +38,8 @@ (define-method (live-properties (self <virtual-resource>)) (append (next-method) - (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) (make-live-property isvirtual set-isvirtual!))))) + (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) + (make-live-property isvirtual set-isvirtual!))))) (define-method (content (self <virtual-resource>)) (content* self)) |