((or (= (string-length l) 0) (string-suffix? "/" l)) 1)
((has-suffix? l ".txt" ".org" ".md") 0)
((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I)
((or (= (string-length l) 0) (string-suffix? "/" l)) 1)
((has-suffix? l ".txt" ".org" ".md") 0)
((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I)
(let* ((selector-list (string-split raw-selector "\t"))
(selector (car selector-list))
(arguments (cdr selector-list)))
(case (infer-selector-type selector)
((1) (serve-directory selector config))
((0) (serve-text-file selector config))
(let* ((selector-list (string-split raw-selector "\t"))
(selector (car selector-list))
(arguments (cdr selector-list)))
(case (infer-selector-type selector)
((1) (serve-directory selector config))
((0) (serve-text-file selector config))
-(define (serve-query selector arguments remote-ip config)
- (let ((file-name (make-pathname (config-root-dir config)
- (conc (string-chomp selector "?") ".scm"))))
+(define (serve-query selector arguments config)
+ (let ((file-name (make-pathname (config-root-dir config) selector)))
(if (and (regular-file? file-name)
(= (length arguments) 1))
(with-input-from-file file-name
(if (and (regular-file? file-name)
(= (length arguments) 1))
(with-input-from-file file-name
(('shell command) (serve-shell-command command dir-selector config))
(('eval expression) (serve-expression expression dir-selector config))
(('url display-string url)
(('shell command) (serve-shell-command command dir-selector config))
(('eval expression) (serve-expression expression dir-selector config))
(('url display-string url)
((type display-string selector host port)
(print type display-string "\t" selector "\t" host "\t" port "\r"))
((type display-string selector host)
((type display-string selector host port)
(print type display-string "\t" selector "\t" host "\t" port "\r"))
((type display-string selector host)
- (serve-info-records (string-chomp (read-string #f in-port) "\n"))))))
+ (let ((string (read-string #f in-port)))
+ (if (and (not (eof-object? string))
+ (> (string-length string) 0))
+ (serve-info-records (string-chomp string "\n"))))))))
- (change-directory directory)
- (set! result (thunk))
- (change-directory old-wd)
- result))
+ (condition-case
+ (begin
+ (change-directory directory)
+ (set! result (thunk))
+ (change-directory old-wd)
+ result)
+ (o (exn)
+ (change-directory old-wd)
+ (signal o)))))