From: Tim Vaughan <tgvaughan@gmail.com>
Date: Fri, 3 May 2019 10:15:17 +0000 (+0200)
Subject: Add shell command record type.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scratchy.git;a=commitdiff_plain;h=609bba713d00f7fe14b8c1369985f9b4be4ecd18

Add shell command record type.
---

diff --git a/burrow.scm b/burrow.scm
index 899edae..c258311 100644
--- a/burrow.scm
+++ b/burrow.scm
@@ -8,7 +8,7 @@
         (chicken condition)
         (chicken process)
         (chicken process-context)
-        srfi-13 matchable)
+        srfi-1 srfi-13 matchable)
 
 (define gopher-index-file-name "index")
 
@@ -124,10 +124,17 @@
 ;;; 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)
@@ -141,10 +148,13 @@
      (serve-record (list (infer-selector-type selector) display-string selector)
                    path config))
     ((selector)
-     (serve-record (list (infer-selector-type selector) 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
 
@@ -164,9 +174,9 @@
               (run-server (make-server-config root hostname port))
               (error "Invalid port argument." port))))))
 
-;; (main)
+(main)
 
-(define (test)
-  (run-server (make-server-config "gopher-root" "localhost" 70)))
+;; (define (test)
+;;   (run-server (make-server-config "gopher-root" "localhost" 70)))
 
 ;; (test)