aboutsummaryrefslogtreecommitdiffstats
path: root/main/guile/CVE-2016-8606.patch
blob: 2ba897db0b712c84b45f8902d57dfa08d6064ece (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
From 08c021916dbd3a235a9f9cc33df4c418c0724e03 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Fri, 9 Sep 2016 07:36:52 -0400
Subject: REPL Server: Guard against HTTP inter-protocol exploitation attacks.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Reported by Christopher Allan Webber <cwebber@dustycloud.org>
Co-authored-by: Ludovic Court├Ęs <ludo@gnu.org>

This commit adds protection to Guile's REPL servers against HTTP
inter-protocol exploitation attacks, a scenario whereby an attacker can,
via an HTML page, cause a web browser to send data to TCP servers
listening on a loopback interface or private network.  See
<https://en.wikipedia.org/wiki/Inter-protocol_exploitation> and
<https://www.jochentopf.com/hfpa/hfpa.pdf>, The HTML Form Protocol
Attack (2001) by Tochen Topf <jochen@remote.org>.

Here we add a procedure to 'before-read-hook' that looks for a possible
HTTP request-line in the first line of input from the client socket.  If
present, the socket is drained and closed, and a loud warning is written
to stderr (POSIX file descriptor 2).

* module/system/repl/server.scm: Add 'maybe-check-for-http-request'
to 'before-read-hook' when this module is loaded.
(with-temporary-port-encoding, with-saved-port-line+column)
(drain-input-and-close, permissive-http-request-line?)
(check-for-http-request, guard-against-http-request)
(maybe-check-for-http-request): New procedures.
(serve-client): Use 'guard-against-http-request'.
* module/system/repl/coop-server.scm (start-repl-client): Use
'guard-against-http-request'.
* doc/ref/guile-invoke.texi (Command-line Options): In the description
of the --listen option, make the security warning more prominent.
Mention the new protection added here.  Recommend using UNIX domain
sockets for REPL servers.  "a path to" => "the file name of".
---
 doc/ref/guile-invoke.texi          |  20 +++-
 module/system/repl/coop-server.scm |   7 +-
 module/system/repl/server.scm      | 182 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 201 insertions(+), 8 deletions(-)

diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi
index 4cf833f..5be8f20 100644
--- a/doc/ref/guile-invoke.texi
+++ b/doc/ref/guile-invoke.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011, 2013
-@c   Free Software Foundation, Inc.
+@c Copyright (C)  1996, 1997, 2000-2005, 2010, 2011, 2013, 2014,
+@c   2016 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Invoking Guile
@@ -176,7 +176,7 @@ the @file{.guile} file.  @xref{Init File}.
 While this program runs, listen on a local port or a path for REPL
 clients.  If @var{p} starts with a number, it is assumed to be a local
 port on which to listen.  If it starts with a forward slash, it is
-assumed to be a path to a UNIX domain socket on which to listen.
+assumed to be the file name of a UNIX domain socket on which to listen.
 
 If @var{p} is not given, the default is local port 37146.  If you look
 at it upside down, it almost spells ``Guile''.  If you have netcat
@@ -184,12 +184,22 @@ installed, you should be able to @kbd{nc localhost 37146} and get a
 Guile prompt.  Alternately you can fire up Emacs and connect to the
 process; see @ref{Using Guile in Emacs} for more details.
 
-Note that opening a port allows anyone who can connect to that port---in
-the TCP case, any local user---to do anything Guile can do, as the user
+@quotation Note
+Opening a port allows anyone who can connect to that port to do anything
+Guile can do, as the user
 that the Guile process is running as.  Do not use @option{--listen} on
 multi-user machines.  Of course, if you do not pass @option{--listen} to
 Guile, no port will be opened.
 
+Guile protects against the
+@uref{https://en.wikipedia.org/wiki/Inter-protocol_exploitation,
+@dfn{HTTP inter-protocol exploitation attack}}, a scenario whereby an
+attacker can, @i{via} an HTML page, cause a web browser to send data to
+TCP servers listening on a loopback interface or private network.
+Nevertheless, you are advised to use UNIX domain sockets, as in
+@code{--listen=/some/local/file}, whenever possible.
+@end quotation
+
 That said, @option{--listen} is great for interactive debugging and
 development.
 
diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm
index c19dda1..ae31ce8 100644
--- a/module/system/repl/coop-server.scm
+++ b/module/system/repl/coop-server.scm
@@ -1,6 +1,6 @@
 ;;; Cooperative REPL server
 
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2016 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -29,7 +29,8 @@
                 #:select (start-repl* prompting-meta-read))
   #:use-module ((system repl server)
                 #:select (run-server* make-tcp-server-socket
-                                      add-open-socket! close-socket!))
+                                      add-open-socket! close-socket!
+                                      guard-against-http-request))
   #:export (spawn-coop-repl-server
             poll-coop-repl-server))
 
@@ -173,6 +174,8 @@ and output is sent over the socket CLIENT."
   ;; another thread.
   (add-open-socket! client (lambda () (close-fdes (fileno client))))
 
+  (guard-against-http-request client)
+
   (with-continuation-barrier
    (lambda ()
      (coop-repl-prompt
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index ff9ee5c..9ece947 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -1,6 +1,6 @@
 ;;; Repl server
 
-;; Copyright (C)  2003, 2010, 2011, 2014 Free Software Foundation, Inc.
+;; Copyright (C)  2003, 2010, 2011, 2014, 2016 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -22,8 +22,13 @@
 (define-module (system repl server)
   #:use-module (system repl repl)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 iconv)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)           ; cut
   #:export (make-tcp-server-socket
             make-unix-domain-server-socket
             run-server
@@ -154,6 +159,8 @@
     ;; Arrange to cancel this thread to forcefully shut down the socket.
     (add-open-socket! client (lambda () (cancel-thread thread))))
 
+  (guard-against-http-request client)
+
   (with-continuation-barrier
    (lambda ()
      (parameterize ((current-input-port client)
@@ -162,3 +169,176 @@
                     (current-warning-port client))
        (with-fluids ((*repl-stack* '()))
          (start-repl))))))
+
+
+;;;
+;;; The following code adds protection to Guile's REPL servers against
+;;; HTTP inter-protocol exploitation attacks, a scenario whereby an
+;;; attacker can, via an HTML page, cause a web browser to send data to
+;;; TCP servers listening on a loopback interface or private network.
+;;; See <https://en.wikipedia.org/wiki/Inter-protocol_exploitation> and
+;;; <https://www.jochentopf.com/hfpa/hfpa.pdf>, The HTML Form Protocol
+;;; Attack (2001) by Tochen Topf <jochen@remote.org>.
+;;;
+;;; Here we add a procedure to 'before-read-hook' that looks for a possible
+;;; HTTP request-line in the first line of input from the client socket.  If
+;;; present, the socket is drained and closed, and a loud warning is written
+;;; to stderr (POSIX file descriptor 2).
+;;;
+
+(define (with-temporary-port-encoding port encoding thunk)
+  "Call THUNK in a dynamic environment in which the encoding of PORT is
+temporarily set to ENCODING."
+  (let ((saved-encoding #f))
+    (dynamic-wind
+      (lambda ()
+        (unless (port-closed? port)
+          (set! saved-encoding (port-encoding port))
+          (set-port-encoding! port encoding)))
+      thunk
+      (lambda ()
+        (unless (port-closed? port)
+          (set! encoding (port-encoding port))
+          (set-port-encoding! port saved-encoding))))))
+
+(define (with-saved-port-line+column port thunk)
+  "Save the line and column of PORT before entering THUNK, and restore
+their previous values upon normal or non-local exit from THUNK."
+  (let ((saved-line #f) (saved-column #f))
+    (dynamic-wind
+      (lambda ()
+        (unless (port-closed? port)
+          (set! saved-line   (port-line   port))
+          (set! saved-column (port-column port))))
+      thunk
+      (lambda ()
+        (unless (port-closed? port)
+          (set-port-line!   port saved-line)
+          (set-port-column! port saved-column))))))
+
+(define (drain-input-and-close socket)
+  "Drain input from SOCKET using ISO-8859-1 encoding until it would block,
+and then close it.  Return the drained input as a string."
+  (dynamic-wind
+    (lambda ()
+      ;; Enable full buffering mode on the socket to allow
+      ;; 'get-bytevector-some' to return non-trivial chunks.
+      (setvbuf socket _IOFBF))
+    (lambda ()
+      (let loop ((chunks '()))
+        (let ((result (and (char-ready? socket)
+                           (get-bytevector-some socket))))
+          (if (bytevector? result)
+              (loop (cons (bytevector->string result "ISO-8859-1")
+                          chunks))
+              (string-concatenate-reverse chunks)))))
+    (lambda ()
+      ;; Close the socket even in case of an exception.
+      (close-port socket))))
+
+(define permissive-http-request-line?
+  ;; This predicate is deliberately permissive
+  ;; when checking the Request-URI component.
+  (let ((cs (ucs-range->char-set #x20 #x7E))
+        (rx (make-regexp
+             (string-append
+              "^(OPTIONS|GET|HEAD|POST|PUT|DELETE|TRACE|CONNECT) "
+              "[^ ]+ "
+              "HTTP/[0-9]+.[0-9]+$"))))
+    (lambda (line)
+      "Return true if LINE might plausibly be an HTTP request-line,
+otherwise return #f."
+      ;; We cannot simplify this to a simple 'regexp-exec', because
+      ;; 'regexp-exec' cannot cope with NUL bytes.
+      (and (string-every cs line)
+           (regexp-exec  rx line)))))
+
+(define (check-for-http-request socket)
+  "Check for a possible HTTP request in the initial input from SOCKET.
+If one is found, close the socket and print a report to STDERR (fdes 2).
+Otherwise, put back the bytes."
+  ;; Temporarily set the port encoding to ISO-8859-1 to allow lossless
+  ;; reading and unreading of the first line, regardless of what bytes
+  ;; are present.  Note that a valid HTTP request-line contains only
+  ;; ASCII characters.
+  (with-temporary-port-encoding socket "ISO-8859-1"
+    (lambda ()
+      ;; Save the port 'line' and 'column' counters and later restore
+      ;; them, since unreading what we read is not sufficient to do so.
+      (with-saved-port-line+column socket
+        (lambda ()
+          ;; Read up to (but not including) the first CR or LF.
+          ;; Although HTTP mandates CRLF line endings, we are permissive
+          ;; here to guard against the possibility that in some
+          ;; environments CRLF might be converted to LF before it
+          ;; reaches us.
+          (match (read-delimited "\r\n" socket 'peek)
+            ((? eof-object?)
+             ;; We found EOF before any input.  Nothing to do.
+             'done)
+
+            ((? permissive-http-request-line? request-line)
+             ;; The input from the socket began with a plausible HTTP
+             ;; request-line, which is unlikely to be legitimate and may
+             ;; indicate an possible break-in attempt.
+
+             ;; First, set the current port parameters to a void-port,
+             ;; to avoid sending any more data over the socket, to cause
+             ;; the REPL reader to see EOF, and to swallow any remaining
+             ;; output gracefully.
+             (let ((void-port (%make-void-port "rw")))
+               (current-input-port   void-port)
+               (current-output-port  void-port)
+               (current-error-port   void-port)
+               (current-warning-port void-port))
+
+             ;; Read from the socket until we would block,
+             ;; and then close it.
+             (let ((drained-input (drain-input-and-close socket)))
+
+               ;; Print a report to STDERR (POSIX file descriptor 2).
+               ;; XXX Can we do better here?
+               (call-with-port (dup->port 2 "w")
+                 (cut format <> "
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+@@ POSSIBLE BREAK-IN ATTEMPT ON THE REPL SERVER                @@
+@@ BY AN HTTP INTER-PROTOCOL EXPLOITATION ATTACK.  See:        @@
+@@ <https://en.wikipedia.org/wiki/Inter-protocol_exploitation> @@
+@@ Possible HTTP request received: ~S
+@@ The associated socket has been closed.                      @@
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
+                      (string-append request-line
+                                     drained-input)))))
+
+            (start-line
+             ;; The HTTP request-line was not found, so
+             ;; 'unread' the characters that we have read.
+             (unread-string start-line socket))))))))
+
+(define (guard-against-http-request socket)
+  "Arrange for the Guile REPL to check for an HTTP request in the
+initial input from SOCKET, in which case the socket will be closed.
+This guards against HTTP inter-protocol exploitation attacks, a scenario
+whereby an attacker can, via an HTML page, cause a web browser to send
+data to TCP servers listening on a loopback interface or private
+network."
+  (%set-port-property! socket 'guard-against-http-request? #t))
+
+(define* (maybe-check-for-http-request
+          #:optional (socket (current-input-port)))
+  "Apply check-for-http-request to SOCKET if previously requested by
+guard-against-http-request.  This procedure is intended to be added to
+before-read-hook."
+  (when (%port-property socket 'guard-against-http-request?)
+    (check-for-http-request socket)
+    (unless (port-closed? socket)
+      (%set-port-property! socket 'guard-against-http-request? #f))))
+
+;; Install the hook.
+(add-hook! before-read-hook
+           maybe-check-for-http-request)
+
+;;; Local Variables:
+;;; eval: (put 'with-temporary-port-encoding 'scheme-indent-function 2)
+;;; eval: (put 'with-saved-port-line+column  'scheme-indent-function 1)
+;;; End:
-- 
cgit v1.0