source: project/release/4/vandusen/trunk/vandusen-remote.scm @ 30305

Last change on this file since 30305 was 30305, checked in by Moritz Heidkamp, 7 years ago

vandusen: Only allow a single remote command per connection

This hopefully fixes vandusen's problem with multiline commit messages such as this one.

File size: 1.5 KB
Line 
1(module vandusen-remote ()
2
3(import chicken scheme)
4(require-library regex)
5(import irregex)
6(use extras srfi-13 vandusen tcp srfi-18 ports)
7
8(plugin 'remote
9        (lambda ()
10          (let ((listener (tcp-listen ($ 'remote-port)
11                                      (or ($ 'remote-backlog) 10)
12                                      (or ($ 'remote-host) "localhost"))))
13            (add-finalizer (lambda ()
14                             (debug "finalizing remote listener")
15                             (tcp-close listener)))
16
17            (thread-start! (lambda ()
18                             (let loop ()
19                               (receive (in out) (tcp-accept listener)
20                                 (thread-start! (lambda ()
21                                                  (let ((line (read-line in)))
22                                                    (and-let* ((match (irregex-match 
23                                                                       '(seq (submatch (+ (~ space)))
24                                                                             " " 
25                                                                             (submatch (+ any)))
26                                                                       line)))
27                                                      (say (string-trim (irregex-match-substring match 2))
28                                                           (irregex-match-substring match 1))))
29                                                  (close-input-port in)
30                                                  (close-output-port out)))
31                                 (loop)))))))))
Note: See TracBrowser for help on using the repository browser.