+(define (serve-info-records string)
+ (for-each
+ (lambda (line)
+ (print* "i")
+ (for-each (lambda (char)
+ (print* (if (eq? char #\tab)
+ " "
+ char)))
+ (string->list line))
+ (print "\tfake\tfake\t1\r"))
+ (string-split string "\n" #t)))
+
+(define (serve-record record dir-selector config)
+ (match record
+ (('shell command) (serve-shell-command command dir-selector config))
+ (('eval expression) (serve-expression expression dir-selector config))
+ (('url display-string url)
+ (print #\h display-string "\tURL:" url "\tfake\t80\r"))
+ ((type display-string selector host port)
+ (print type display-string "\t" selector "\t" host "\t" port "\r"))
+ ((type display-string selector host)
+ (serve-record (list type display-string selector host 70)
+ dir-selector config))
+ ((type display-string selector)
+ (serve-record (list type display-string
+ (make-pathname dir-selector selector)
+ (config-host config) (config-port config))
+ dir-selector config))
+ ((display-string selector)
+ (serve-record (list (infer-selector-type selector) display-string selector)
+ dir-selector config))
+ ((selector)
+ (serve-record (list (infer-selecto-type selector) selector)
+ dir-selector config))
+ (else (error "Unknown record type."))))
+
+(define (serve-shell-command command dir-selector config)
+ (with-selector-dir
+ dir-selector config
+ (lambda ()
+ (let-values (((in-port out-port id) (process command)))
+ (serve-info-records (string-chomp (read-string #f in-port) "\n"))))))
+
+(define (serve-expression expression dir-selector config)
+ (with-selector-dir
+ dir-selector config
+ (lambda ()
+ (serve-info-records (conc (eval expression))))))
+
+
+;;; Utility methods
+
+(define (with-current-working-directory directory thunk)
+ (let ((old-wd (current-directory))
+ (result 'none))
+ (change-directory directory)
+ (set! result (thunk))
+ (change-directory old-wd)
+ result))
+
+(define (with-selector-dir selector config thunk)
+ (with-current-working-directory
+ (make-pathname (config-root-dir config)
+ (pathname-directory selector)) thunk))