Write listener object

starvat/main.scm

@@ -0,0 +1,57 @@
+(define-module (starvat)
+  #:use-module (gnutls)
+  #:use-module (goblins)
+  #:use-module (goblins actor-lib methods)
+  #:use-module (goblins actor-lib let-on)
+  #:use-module (goblins actor-lib cell)
+  #:use-module (web uri)
+  #:use-module (ice-9 textual-ports))
+
+(define listener-vat (spawn-vat))
+
+(define* (get-request port #:optional (acc ""))
+  (define next-char (get-char port))
+  (if (and (eq? next-char #\return)
+		   (eq? (lookahead-char port) #\newline))
+	  acc
+	  (get-request port (string-append acc (string next-char)))))
+
+(define* (^listener bcom port cert key #:key exposed?)
+  (define current-port (spawn ^cell port))
+  (define listening-socket (spawn ^cell))
+  (define credentials (spawn ^cell (make-certificate-credentials)))
+  (set-certificate-credentials-x509-key-files!
+   ($ credentials) cert key x509-certificate-format/pem)
+  (define server (spawn ^cell (make-session connection-end/server)))
+  (set-session-credentials! ($ server) ($ credentials))
+  (set-session-default-priority! ($ server))
+
+  (methods
+   ((set-port new-port)
+	($ current-port new-port))
+   ((set-credentials cert key)
+	(set-certificate-credentials-x509-key-files!
+	 ($ credentials) cert key x509-certificate-format/pem))
+   ((init)
+	($ listening-socket
+	   (let ((s (socket PF_INET SOCK_STREAM 0)))
+		 (setsockopt s SOL_SOCKET SO_REUSEADDR 1)
+		 (bind s AF_INET INADDR_ANY ($ current-port))
+		 (fcntl s F_SETFD FD_CLOEXEC)
+		 (listen s 5)
+		 s)))
+   ((listen)
+	(let* ((session (make-session connection-end/server))
+		   (sock (car (accept ($ listening-socket)))))
+	  (set-session-credentials! session ($ credentials))
+	  (set-session-default-priority! session)
+	  (set-session-transport-fd! session
+								 (fileno sock))
+	  (set-port-encoding! sock "UTF-8")
+	  (handshake session)
+	  (write (get-request (session-record-port session)))
+	  (put-string (session-record-port session)
+				  (string-append "41 Server is being written!" "\r\n"))
+	  (bye session close-request/rdwr)))
+   ((close)
+	(close ($ listening-socket)))))