aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--main/guile/APKBUILD21
-rw-r--r--main/guile/CVE-2016-8605.patch86
-rw-r--r--main/guile/CVE-2016-8606.patch337
3 files changed, 440 insertions, 4 deletions
diff --git a/main/guile/APKBUILD b/main/guile/APKBUILD
index d401afd60a..39d88df7d4 100644
--- a/main/guile/APKBUILD
+++ b/main/guile/APKBUILD
@@ -1,7 +1,7 @@
# Maintainer: Natanael Copa <ncopa@alpinelinux.org>
pkgname=guile
pkgver=2.0.11
-pkgrel=2
+pkgrel=3
pkgdesc="Guile is a portable, embeddable Scheme implementation written in C"
url="http://www.gnu.org/software/guile/"
arch="all"
@@ -24,8 +24,15 @@ source="ftp://ftp.gnu.org/pub/gnu/$pkgname/$pkgname-$pkgver.tar.gz
0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
strtol_l.patch
+ CVE-2016-8605.patch
+ CVE-2016-8606.patch
"
+# secfixes:
+# 2.0.11-r3:
+# - CVE-2016-8605
+# - CVE-2016-8606
+
_builddir="$srcdir"/$pkgname-$pkgver
prepare() {
cd "$_builddir"
@@ -68,7 +75,9 @@ f140776c944bacc6cc14919f83902696 0003-Recognize-more-ARM-targets.patch
9e7b0d2d52e22b253ac314c6cb317bb4 0013-Handle-p-in-format-warnings.patch
9bb62ca4bd913b5ba6a94868a2d33464 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
04012be1e50736374564b14440e410f6 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
-54b76be46ecc9333e2a57cc0906c1927 strtol_l.patch"
+54b76be46ecc9333e2a57cc0906c1927 strtol_l.patch
+1c57e6341d07a224cdbc551ec8d6d204 CVE-2016-8605.patch
+070801b5311195d67e60c00ab0c52d8b CVE-2016-8606.patch"
sha256sums="e6786c934346fa2e38e46d8d81a622bb1c16d130153523f6129fcd79ef1fb040 guile-2.0.11.tar.gz
760355a63be9b756607a03352ceb916dfba02da917fa00c6bc07253d0f7c75f6 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch
1b438b5b513f6711c098a54944f907e4b4744bfd1b9315fb8bc33c67a1481952 0003-Recognize-more-ARM-targets.patch
@@ -79,7 +88,9 @@ b7b3425c807d227dccf0ada653d3edd6d343d6c9d7ee648140bd13812f7776e7 0011-Fix-shrin
3557178fec43d58c62a505a3199054d4f32da97cfafaa969a8e9b90616bc603f 0013-Handle-p-in-format-warnings.patch
4ded8227e4b93a5205ddcf43f01e0e8c7684396669192b2e95b2c710573b6395 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
d28837b89c1653d9addf80573934dc97128a0c464b531f64fc58b1577f60340a 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
-2ba49adb27db50f5ec33779ce2f002cafde99a04038ca689bee7d2098296ce33 strtol_l.patch"
+2ba49adb27db50f5ec33779ce2f002cafde99a04038ca689bee7d2098296ce33 strtol_l.patch
+b3ec6eb44c1da56ae0ff3b942eff5c2b58ff7d194517e84ac80588344778ae2c CVE-2016-8605.patch
+8fdde4ca1939916080fde3e484f5449669dfc0244eb75a9b7192b576bef72d84 CVE-2016-8606.patch"
sha512sums="dc1a30d44e6d432fab2407d72385e959af863f6feba6cca5813b4de24c92200c78b44f336d1f4fa8c7b4058dea880982787c69888c91a2236fd2fb1d313137fd guile-2.0.11.tar.gz
b1c309cc07830ff1741ef88857f8099187b449580e8d57862886abc367ef1accc5a35636d81eee09247f13d3a751cdc8909fdea05368d3d509bd2039ce06d078 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch
0d3a5fd9ebd34d65f9c5534ea87a161099f4e0d1aae0153226962776ad0b823becd1688fe431c8425968d44377aec5ba2f81865924652125f6356b5f9d993101 0003-Recognize-more-ARM-targets.patch
@@ -90,4 +101,6 @@ b283ac11ca5d01a4ab102258ff896fb3fb6cb053144ea31ae0d43c0229c9b9509c4eadc90d757b23
8484e882723d68ea1e658a86c7be5006de1af7d457f7f9a37a99b427460db8420980174efdcaff8fbfa49346ba01252d2e6183c8b5e323bd228d223ed011655b 0013-Handle-p-in-format-warnings.patch
5f450e57968f2f0592a0de6beaa02db315d668a31a85330e3aa44d87995c82f866828fceb71012c123f5dd3b3b5c3ec944c8011ba09658ad00e8ce1c6f958a87 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
f55e514534fd1aba547ed8d4350fbeeaef77d634d7f1915a0108244a9bef5afe7074f3292b9f74bdccd0c56cddc60e222e9ccd2519ba337b6f156123e632ec26 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
-596efb03c65df98ea9afd932cb67e5b436e35fbf2442630e8a1854818f246b5a24eb920e3502ba28b882f0afb27c5148f1ff509c29baa91a7f37b3ecdc28c000 strtol_l.patch"
+596efb03c65df98ea9afd932cb67e5b436e35fbf2442630e8a1854818f246b5a24eb920e3502ba28b882f0afb27c5148f1ff509c29baa91a7f37b3ecdc28c000 strtol_l.patch
+3dea35a25321e50ba3b74bab45cb7d81335a82026c3f46b56079e79b00bcfeaa3cdfbe0d2834314d9a86a19eea5e8beaa9b8edef94b42cd2cdf2671203c0236b CVE-2016-8605.patch
+aa9c7e546802255f349ba4567cd8f532fb3156edf65b1acc32b3b330db19a407390509fae63c944b946c7d86b99728561a446d64d758a5667bd4b7b5055bfbc4 CVE-2016-8606.patch"
diff --git a/main/guile/CVE-2016-8605.patch b/main/guile/CVE-2016-8605.patch
new file mode 100644
index 0000000000..aee593fbd5
--- /dev/null
+++ b/main/guile/CVE-2016-8605.patch
@@ -0,0 +1,86 @@
+From 245608911698adb3472803856019bdd5670b6614 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
+Date: Tue, 11 Oct 2016 10:14:26 +0200
+Subject: Remove 'umask' calls from 'mkdir'.
+
+Fixes <http://bugs.gnu.org/24659>.
+
+* libguile/filesys.c (SCM_DEFINE): Remove calls to 'umask' when MODE is
+unbound; instead, use 0777 as the mode. Update docstring to clarify
+this.
+* doc/ref/posix.texi (File System): Adjust accordingly.
+* NEWS: Mention it.
+---
+ NEWS | 14 +++++++++++++-
+ doc/ref/posix.texi | 7 ++++---
+ libguile/filesys.c | 25 ++++++++++---------------
+ 3 files changed, 27 insertions(+), 19 deletions(-)
+
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index 2b9011d..a818604 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -864,9 +864,10 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
+ @deffn {Scheme Procedure} mkdir path [mode]
+ @deffnx {C Function} scm_mkdir (path, mode)
+ Create a new directory named by @var{path}. If @var{mode} is omitted
+-then the permissions of the directory file are set using the current
+-umask (@pxref{Processes}). Otherwise they are set to the decimal
+-value specified with @var{mode}. The return value is unspecified.
++then the permissions of the directory are set to @code{#o777}
++masked with the current umask (@pxref{Processes, @code{umask}}).
++Otherwise they are set to the value specified with @var{mode}.
++The return value is unspecified.
+ @end deffn
+
+ @deffn {Scheme Procedure} rmdir path
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index e6e1db5..e6e37b0 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -1,5 +1,5 @@
+ /* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
+- * 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
++ * 2009, 2010, 2011, 2012, 2013, 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 License
+@@ -1255,26 +1255,21 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
+ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
+ (SCM path, SCM mode),
+ "Create a new directory named by @var{path}. If @var{mode} is omitted\n"
+- "then the permissions of the directory file are set using the current\n"
+- "umask. Otherwise they are set to the decimal value specified with\n"
+- "@var{mode}. The return value is unspecified.")
++ "then the permissions of the directory are set to @code{#o777}\n"
++ "masked with the current umask (@pxref{Processes, @code{umask}}).\n"
++ "Otherwise they are set to the value specified with @var{mode}.\n"
++ "The return value is unspecified.")
+ #define FUNC_NAME s_scm_mkdir
+ {
+ int rv;
+- mode_t mask;
++ mode_t c_mode;
+
+- if (SCM_UNBNDP (mode))
+- {
+- mask = umask (0);
+- umask (mask);
+- STRING_SYSCALL (path, c_path, rv = mkdir (c_path, 0777 ^ mask));
+- }
+- else
+- {
+- STRING_SYSCALL (path, c_path, rv = mkdir (c_path, scm_to_uint (mode)));
+- }
++ c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
++
++ STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode));
+ if (rv != 0)
+ SCM_SYSERROR;
++
+ return SCM_UNSPECIFIED;
+ }
+ #undef FUNC_NAME
+--
+cgit v1.0
+
diff --git a/main/guile/CVE-2016-8606.patch b/main/guile/CVE-2016-8606.patch
new file mode 100644
index 0000000000..2ba897db0b
--- /dev/null
+++ b/main/guile/CVE-2016-8606.patch
@@ -0,0 +1,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
+