gs.scm

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