aboutsummaryrefslogtreecommitdiff
path: root/module/calp
diff options
context:
space:
mode:
Diffstat (limited to 'module/calp')
-rw-r--r--module/calp/server/webdav.scm38
-rw-r--r--module/calp/webdav/resource/virtual.scm3
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))