(chicken condition)
(chicken process)
(chicken process-context)
- srfi-13)
+ srfi-1 srfi-13 matchable)
(define gopher-index-file-name "index")
(server-loop))
(tcp-close listener)))
+;;; Selector type inference
-;;; Selector retrieval
+(define (has-suffix? selector . suffixes)
+ (if (null? suffixes)
+ #f
+ (if (string-suffix? (car suffixes) selector)
+ #t
+ (apply has-suffix? selector (cdr suffixes)))))
-(define (directory-selector? selector)
- (string-suffix? "/" selector))
+(define (infer-selector-type selector)
+ (let ((l (string-downcase selector)))
+ (cond
+ ((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)
+ (else 9))))
+
+;;; Selector retrieval
-(define (text-selector? selector)
- (apply or (map (lambda (ext) (string-suffix? ext selector))
- '(".txt" ".org" ".md"))))
-
(define (serve-selector selector config)
- ((cond
- ((directory-selector? selector) serve-directory)
- ((text-selector? seletor) serve-text-file)
- (else serve-binary-file))
+ ((case (infer-selector-type selector)
+ ((1) serve-directory)
+ ((0) serve-text-file)
+ (else serve-binary-file))
selector config))
(define (serve-directory path config)
;;; Index rendering
(define (serve-info-record info-string)
- (print "i" info-string "\tfake\tfake\t1\r"))
+ (print* "i")
+ (for-each (lambda (char)
+ (print* (if (eq? char #\tab)
+ " "
+ char)))
+ (string->list info-string))
+ (print "\tfake\tfake\t1\r"))
+
+(define (serve-record record path config)
+ (match record
+ (('shell command) (serve-shell-command command))
+ ((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)
+ path config))
+ ((type display-string selector)
+ (serve-record (list type display-string selector
+ (server-host config) (server-port config))
+ path config))
+ ((display-string selector)
+ (serve-record (list (infer-selector-type selector) display-string selector)
+ path config))
+ ((selector)
+ (serve-record (list (infer-selecto-type selector) selector)
+ path config))
+ (else (error "Unknown record type."))))
+
+(define (serve-shell-command command)
+ (let-values (((in-port out-port id) (process command)))
+ (for-each serve-info-record (read-lines in-port))))
;;; main
(main)
;; (define (test)
- ;; (run-server (make-server-config "gopher-root" "localhost" 70)))
+;; (run-server (make-server-config "gopher-root" "localhost" 70)))
;; (test)