gs.scm

   1 (import (chicken tcp)
   2         (chicken port)
   3         (chicken io)
   4         (chicken string)
   5         (chicken pathname)
   6         (chicken time posix)
   7         srfi-1
   8         srfi-13)
   9
  10 (define gopher-root "./gopher-root")
  11 (define index-file-name "index")
  12 (define gopher-server-hostname "egan.icytree.org")
  13 (define gopher-server-port 70)
  14
  15 (define (run-server)
  16   (let ((listener (tcp-listen gopher-server-port)))
  17     (print "Gopher server listening on port " gopher-server-port " ...")
  18     (let-values (((in-port out-port) (tcp-accept listener)))
  19       (let* ((line (read-line in-port))
  20              (selector (string-trim-both line)))
  21         (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
  22           (print "Accepted connection from " remote-ip
  23                  " on " (seconds->string)))
  24         (with-output-to-port out-port
  25           (lambda ()
  26             (retrieve-selector
  27              (if (= (string-length selector) 0)
  28                  "/"
  29                  selector)
  30              gopher-root
  31              gopher-server-hostname
  32              gopher-server-port)))
  33         (print "... retrieved selector '" selector "'. Closing connection."))
  34       (close-input-port in-port)
  35       (close-output-port out-port))
  36     (tcp-close listener))
  37   (run-server))
  38
  39 ;;; Selector retrieval
  40
  41 (define (retrieve-selector selector gopher-root server-host server-port)
  42   (if (string-suffix? "/" selector)
  43       (retrieve-index-file (make-pathname gopher-root (make-pathname selector index-file-name))
  44                            server-host
  45                            server-port)
  46       (retrieve-text-file (make-pathname gopher-root selector)
  47                           server-host
  48                           server-port)))
  49
  50 (define (retrieve-index-file index-file-name server-host server-port)
  51   (with-input-from-file index-file-name
  52     (lambda ()
  53       (render-index (read)
  54                     server-host
  55                     server-port))))
  56
  57 (define (retrieve-text-file file-name server-host server-port)
  58   (with-input-from-file file-name
  59     (lambda ()
  60       (for-each
  61        (lambda (line)
  62          (print line "\r"))
  63        (read-lines)))))
  64
  65 ;;; Index rendering
  66
  67 (define entry-type car)
  68
  69 (define entry-name cadr)
  70
  71 (define (has-selector? entry) (>= (length entry) 3))
  72
  73 (define (entry-selector entry) (list-ref entry 2))
  74
  75 (define (has-host? entry) (>= (length entry) 4))
  76
  77 (define (entry-host entry) (list-ref entry 3))
  78
  79 (define (has-port? entry) (>= (length entry) 5))
  80
  81 (define (entry-port entry) (list-ref entry 4))
  82
  83 (define (render-entry entry default-selector default-host default-port)
  84   (let ((name-string (entry-name entry)))
  85     (for-each
  86      (lambda (name-string-line)
  87        (print* (entry-type entry) name-string-line)
  88        (print* "\t" (if (has-selector? entry)
  89                         (entry-selector entry)
  90                         default-selector))
  91        (print* "\t" (if (has-host? entry)
  92                         (entry-host entry)
  93                         default-host))
  94        (print* "\t" (if (has-port? entry)
  95                         (entry-port entry)
  96                         default-port))
  97        (print* "\r\n"))
  98      (string-split name-string "\n" #t))))
  99
 100 (define (render-index index this-host this-port)
 101   (for-each
 102    (lambda (entry)
 103      (if (eq? (entry-type entry) 'i)
 104          (render-entry entry "fake.selector" "fake.host" 1)
 105          (render-entry entry "" this-host this-port)))
 106    index)
 107   (print "."))