1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00

REPL Server: Guard against HTTP inter-protocol exploitation attacks.

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".
This commit is contained in:
Mark H Weaver 2016-09-09 07:36:52 -04:00 committed by Andy Wingo
parent b473598f26
commit 402162cfcf
3 changed files with 203 additions and 9 deletions

View file

@ -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, 2014
@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.

View file

@ -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
@ -25,7 +25,6 @@
#:use-module (ice-9 threads)
#:use-module (ice-9 q)
#:use-module (srfi srfi-9)
#:use-module ((system repl server) #:select (make-tcp-server-socket))
#:export (spawn-coop-repl-server
poll-coop-repl-server))
@ -35,7 +34,9 @@
(define sym (@@ module sym))
...))
(import-private (system repl repl) start-repl* prompting-meta-read)
(import-private (system repl server) run-server* add-open-socket! close-socket!)
(import-private (system repl server)
run-server* add-open-socket! close-socket!
make-tcp-server-socket guard-against-http-request)
(define-record-type <coop-repl-server>
(%make-coop-repl-server mutex queue)
@ -177,6 +178,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

View file

@ -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,14 @@
(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 (ice-9 binary-ports)
#:use-module ((rnrs io ports) #:select (call-with-port))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) ; cut
#:export (make-tcp-server-socket
make-unix-domain-server-socket
run-server
@ -136,6 +142,8 @@
;; To shut down this thread and socket, cause it to unwind.
(add-open-socket! client (lambda () (cancel-thread thread))))
(guard-against-http-request client)
(dynamic-wind
(lambda () #f)
(with-continuation-barrier
@ -147,3 +155,176 @@
(with-fluids ((*repl-stack* '()))
(start-repl)))))
(lambda () (close-socket! client))))
;;;
;;; 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: